&MMM     PROC  &P,0,                                                   XEM000010
               &DISC=,                                                 XEM000020
               &TAPE=,                                                 XEM000030
               &COMP=,                                                 XEM000040
               &PGNM=,                                                 XEM000050
               &SEPAS=                                                  EM000060
EMDT     NAME                                                           EM000070
         LCL   &D                                                       EM000080
         LCL   &T                                                       EM000090
         LCL   &CCC                                                     EM000100
         LCL   &NNN                                                     EM000110
         LCL   &W                                                       EM000120
         LCL   &SSS                                                     EM000130
&SSS     SET   0                                                        EM000140
         DO    '&SEPAS'='YES'                                           EM000150
&SSS     SET   1                                                        EM000160
         ENDO                                                           EM000170
         DO    '&PGNM'=''                                               EM000180
&NNN     SET   'DTE360'                                                 EM000190
         GOTO  .X$000                                                   EM000200
         ENDO                                                           EM000210
&NNN     SET   '&PGNM'                                                  EM000220
.X$000   LABEL                                                          EM000230
&W       SET   0                                                        EM000240
         DO    '&DISC'=''                                               EM000250
&D       SET   0                                                        EM000260
         GOTO  .X$002                                                   EM000270
         ENDO                                                           EM000280
         DO    '&DISC'<'1'                                              EM000290
         GOTO  .X$001                                                   EM000300
         ENDO                                                           EM000310
         DO    '&DISC'>'8'                                              EM000320
         GOTO  .X$001                                                   EM000330
         ENDO                                                           EM000340
&D       SET   &DISC                                                    EM000350
         GOTO  .X$002                                                   EM000360
.X$001   LABEL                                                          EM000370
         PNOTE *,'DT20 DISC = PARAMETER INVALID'                        EM000380
&W       SET   1                                                        EM000390
.X$002   LABEL                                                          EM000400
         DO    '&TAPE'=''                                               EM000410
&T       SET   0                                                        EM000420
         GOTO  .X$004                                                   EM000430
         ENDO                                                           EM000440
         DO    '&TAPE'<'1'                                              EM000450
         GOTO  .X$003                                                   EM000460
         ENDO                                                           EM000470
         DO    '&TAPE'>'6'                                              EM000480
         GOTO  .X$003                                                   EM000490
         ENDO                                                           EM000500
&T       SET   &TAPE                                                    EM000510
         GOTO  .X$004                                                   EM000520
.X$003   LABEL                                                          EM000530
         PNOTE *,'DT20 TAPE= PARAMETER INVALID'                         EM000540
&W       SET   1                                                        EM000550
.X$004   LABEL                                                          EM000560
         DO    &W=0                                                     EM000570
         DO    &D=0                                                     EM000580
         DO    &T=0                                                     EM000590
         PNOTE *,'DT20 DISC= AND TAPE= PARAMETERS MISSING'              EM000600
&W       SET   1                                                        EM000610
         ENDO                                                           EM000620
         ENDO                                                           EM000630
         ENDO                                                           EM000640
&CCC     SET   0                                                        EM000650
         DO    '&COMP'=''                                               EM000660
         GOTO  .X$005                                                   EM000670
         ENDO                                                           EM000680
         DO    '&COMP'='NO'                                             EM000690
         GOTO  .X$005                                                   EM000700
         ENDO                                                           EM000710
         DO    '&COMP'='YES'                                            EM000720
&CCC     SET   1                                                        EM000730
         GOTO  .X$005                                                   EM000740
         ENDO                                                           EM000750
         PNOTE *,'DT20 COMP= PARAMETER INVALID'                         EM000760
&W       SET   1                                                        EM000770
.X$005   LABEL                                                          EM000780
         DO    &D=0                                                     EM000790
         DO    &CCC                                                     EM000800
         PNOTE *,'DT20 DISC=/COMP= PARAMETERS INCOMPATABLE'             EM000810
&W       SET   1                                                        EM000820
         ENDO                                                           EM000830
         ENDO                                                           EM000840
         DO    &W                                                       EM000850
         PNOTE *,'DT20 NOT GENERATED'                                   EM000860
         GOTO  .X$999                                                   EM000870
         ENDO                                                           EM000880
*                                                                       EM000890
*                                                                       EM000900
*                                                                       EM000910
&W       SET   '&NNN'.'20'                                              EM000920
         DO    &SSS=0                                                   EM000930
&W       CSCTAR                                                         EM000940
         ENDO                                                           EM000950
         DO    &SSS=1                                                   EM000960
&W       STRTAR                                                         EM000970
         ENDO                                                           EM000980
         DO    '&NNN'='DTE360'                                          EM000990
         GOTO  .X$100                                                   EM001000
         ENDO                                                           EM001010
*                                                                       EM001020
*                                                                       EM001030
DTE36020 DS    0H                                                       EM001040
         ENTRY DTE36020                                                 EM001050
.X$100   LABEL                                                          EM001060
*                                                                       EM001070
*                                                                       EM001080
         USING PCR,3                                                    EM001090
         USING BCB,4                                                    EM001100
         USING CCW,5                                                    EM001110
         USING E2$RADTB,6                                               EM001120
         USING XIO,7                                                    EM001130
         USING PGM,8                                                    EM001140
         USING CCB,9                                                    EM001150
         USING SAT,10                                                   EM001160
         USING FCB,11                                                   EM001170
*                                                                       EM001180
*                                                                       EM001190
         ENTRY TAPEECB                                                  EM001200
         ENTRY DISKECB                                                  EM001210
         ENTRY DSKTPHSK                                                 EM001220
         ENTRY DSKIPL                                                   EM001230
         ENTRY NODSKIPL                                                 EM001240
         ENTRY DSKEOJ                                                   EM001250
         ENTRY DSKFETCH                                                 EM001260
         ENTRY DSKMOUNT                                                 EM001270
         ENTRY DSKTPERR                                                 EM001280
         ENTRY DSKTPIO                                                  EM001290
         ENTRY DSKTPCLS                                                 EM001300
*                                                                       EM001310
*                                                                       EM001320
         DO    &SSS=1                                                   EM001330
         TITLE '360/20 DISC/TAPE EMULATOR - STANDARD EQUATES - &NNN'    EM001340
*                                                                       EM001350
*                                                                       EM001360
******** SUEQAR START                                                   EM001370
         SUEQAR                                                         EM001380
******** SUEQAR END                                                     EM001390
         ENDO                                                           EM001400
         TITLE '360/20 DISC/TAPE EMULATOR - DEVICE TABLES - &NNN'       EM001410
*                                                                       EM001420
*                                                                       EM001430
         DO    &D>0                                                     EM001440
XIO1     DS    0F                                                       EM001450
*                                                                       EM001460
&W       SET   1                                                        EM001470
         DO    &D                                                       EM001480
         DC    X'0&W'                                                   EM001490
         DC    XL3'00'                                                  EM001500
         DC    A(E2$DC00&W)                                             EM001510
         DC    XL8'00'                                                  EM001520
         DC    C'&W'                                                    EM001530
         DC    C'00'                                                    EM001540
         DC    XL9'00'                                                  EM001550
*                                                                       EM001560
&W       SET   &W+1                                                     EM001570
         ENDO                                                           EM001580
         DC    F'0'                DISK XIO TABLE DELIMETER             EM001590
*                                                                       EM001600
         ENDO                                                           EM001610
         DO    &T>0                                                     EM001620
TPADDRS  DS    0F                                                       EM001630
*                                                                       EM001640
&W       SET   0                                                        EM001650
         DO    &T                                                       EM001660
         DC    X'8&W'                                                   EM001670
         DC    AL3(TP&W)                                                EM001680
         DC    X'C0CF'             9-TRK MODE SET MASK - 00FF IF 7-TRK  EM001690
         DC    XL2'00'                                                  EM001700
*                                                                       EM001710
&W       SET   &W+1                                                     EM001720
         ENDO                                                           EM001730
         DC    F'0'                TAPE ADDR TABLE DELIMETER            EM001740
*                                                                       EM001750
         ENDO                                                           EM001760
&W       SET   1                                                        EM001770
         DO    &D                                                       EM001780
         TITLE '360/20 DISC/TAPE EMULATOR - DISC DRIVE &W - &NNN'       EM001790
*                                                                       EM001800
*                                                                       EM001810
******** SAT   START                                                    EM001820
E2$DC00&W SAT  PCA1=PCA&W,                                             XEM001830
               ERROR=SATERROR,                                         XEM001840
               EXTENTS=1                                                EM001850
******** SAT   END                                                      EM001860
*                                                                       EM001870
*                                                                       EM001880
******** PCA   START                                                    EM001890
PCA&W    PCA   BLKSIZE=1536,                                           XEM001900
               IOAREA1=BUFFERXX                                         EM001910
******** PCA   END                                                      EM001920
*                                                                       EM001930
&W       SET   &W+1                                                     EM001940
         ENDO                                                           EM001950
&W       SET   0                                                        EM001960
         DO    &T                                                       EM001970
         TITLE '360/20 DISC/TAPE EMULATOR - TAPE DRIVE &W - &NNN'       EM001980
*                                                                       EM001990
*                                                                       EM002000
******** CCB   START                                                    EM002010
TP&W     CCB   E2$TAPE&W,IOTCCW,,X'08'                                  EM002020
******** CCB   END                                                      EM002030
*                                                                       EM002040
*                                                                       EM002050
E2$TAPE&W PIOCB                                                         EM002060
*                                                                       EM002070
&W       SET   &W+1                                                     EM002080
         ENDO                                                           EM002090
*                                                                       EM002100
*                                                                       EM002110
*                                                                       EM002120
         TITLE '360/20 DISC/TAPE EMULATOR - ENTRANCE POINTS - &NNN'     EM002130
*                                                                       EM002140
*                                                                       EM002150
*  HOUSEKEEPING - FIRST TIME - OPEN FILES                               EM002160
*                                                                       EM002170
DSKTPHSK DS    0H                                                       EM002180
         USING *,15                                                     EM002190
         STM   0,14,SVAREA2                                             EM002200
         LA    13,SVAREA1                                               EM002210
         USING SVAREA1,13                                               EM002220
         DROP  15                                                       EM002230
         MVC   PROGNAME,E2$RAPGM                                        EM002240
         L     10,PHASE1                                                EM002250
         B     LOADGO                                                   EM002260
*                                                                       EM002270
         DROP  13                                                       EM002280
*                                                                       EM002290
*                                                                       EM002300
*  HOUSEKEEPING - SECOND TIME - DISK OR TAPE IPL                        EM002310
*                                                                       EM002320
DSKIPL   DS    0H                                                       EM002330
         USING *,15                                                     EM002340
         STM   0,14,SVAREA2                                             EM002350
         LA    13,SVAREA1                                               EM002360
         USING SVAREA1,13                                               EM002370
         DROP  15                                                       EM002380
         L     10,PHASE2A                                               EM002390
         B     LOADGO                                                   EM002400
*                                                                       EM002410
         DROP  13                                                       EM002420
*                                                                       EM002430
*                                                                       EM002440
*  HOUSEKEEPING - SECOND TIME - NO IPL                                  EM002450
*                                                                       EM002460
NODSKIPL DS    0H                                                       EM002470
         USING *,15                                                     EM002480
         STM   0,14,SVAREA2                                             EM002490
         LA    13,SVAREA1                                               EM002500
         USING SVAREA1,13                                               EM002510
         DROP  15                                                       EM002520
         L     10,PHASE2B                                               EM002530
         B     LOADGO                                                   EM002540
*                                                                       EM002550
         DROP  13                                                       EM002560
*                                                                       EM002570
*                                                                       EM002580
*  EOJ                                                                  EM002590
*                                                                       EM002600
DSKEOJ   DS    0H                                                       EM002610
         USING *,15                                                     EM002620
         STM   0,14,SVAREA2                                             EM002630
         LA    13,SVAREA1                                               EM002640
         USING SVAREA1,13                                               EM002650
         DROP  15                                                       EM002660
         SR    9,9                 ZERO IN R9 TO FREE BUFRS BUT NOT CLS EM002670
         BAL   11,CLOSE                                                 EM002680
         L     10,PHASE3A                                               EM002690
         L     12,BASE26                                                EM002700
         LTR   12,12                                                    EM002710
         BNZ   LOADGOX             BRANCH IF CSECT 26 IS RESIDENT       EM002720
         B     LOADGO                                                   EM002730
*                                                                       EM002740
         DROP  13                                                       EM002750
*                                                                       EM002760
*                                                                       EM002770
*  FETCH                                                                EM002780
*                                                                       EM002790
DSKFETCH DS    0H                                                       EM002800
         USING *,15                                                     EM002810
         STM   0,14,SVAREA2                                             EM002820
         LA    13,SVAREA1                                               EM002830
         USING SVAREA1,13                                               EM002840
         DROP  15                                                       EM002850
         SR    9,9                 ZERO IN R9 TO FREE BUFRS BUT NOT CLS EM002860
         BAL   11,CLOSE                                                 EM002870
         L     10,PHASE3B                                               EM002880
         L     12,BASE26                                                EM002890
         LTR   12,12                                                    EM002900
         BNZ   LOADGOX             BRANCH IF CSECT 26 IS RESIDENT       EM002910
         B     LOADGO                                                   EM002920
*                                                                       EM002930
         DROP  13                                                       EM002940
*                                                                       EM002950
*                                                                       EM002960
*  DISK MOUNT                                                           EM002970
*                                                                       EM002980
DSKMOUNT DS    0H                                                       EM002990
         USING *,15                                                     EM003000
         LA    13,SVAREA1                                               EM003010
         USING SVAREA1,13                                               EM003020
         TM    E2$RASWB,X'01'           BRANCH IF THIS AN OPEN          EM003030
         BO    DSKPH4                     FOR IN-LINE MOUNTS            EM003040
         DROP  15                                                       EM003050
         BALR  9,0                 NON-ZERO IN R9 TO FREE BUFRS AND CLS EM003060
         BAL   11,CLOSE                                                 EM003070
DSKPH4   EQU   *                                                        EM003080
         L     10,PHASE4                                                EM003090
         B     LOADGO                                                   EM003100
*                                                                       EM003110
         DROP  13                                                       EM003120
*                                                                       EM003130
*                                                                       EM003140
*  CLOSE                                                                EM003150
*                                                                       EM003160
*    ENTER AT DSKTPERR WITH COMPLETION CODE IN R0 TO DUMP AFTER CLOSE   EM003170
*                                                                       EM003180
         DO    &D>0                                                     EM003190
SATERROR BALR  14,0                                                     EM003200
         USING *,14                                                     EM003210
         CLI   SATERRSW,0               BRANCH IF THE DATA MANAGEMENT   EM003220
         BNE   SATERRI                    ERROR MESSAGE WAS PRINTED     EM003230
         LA    R1,0(,R1)                CLEAR MOST SIGNIFICANT BYTE     EM003240
         MVI   SATERRSW,1               INDICATE ERROR MSG PROCESSING   EM003250
         ST    R2,SATERRSV              SAVE R2                         EM003260
         L     R2,=A(XIO1)              R2 = ADDRESS OF XIO TABLE       EM003270
SATERR05 CLI   0(R2),0                  BRANCH IF THIS IS THE XIO TABLE EM003280
         BE    SATERR15                   TERMINATOR VALUE              EM003290
         C     R1,4(,R2)                COMPARE XIO TABLE ENTRY FOR DTF EM003300
         BE    SATERR10                   WITH ADDRESS OF DTF WITH      EM003310
         LA    R2,28(,R2)                 ERROR CONDITION,  IF NO MATCH EM003320
         B     SATERR05                   GO TO TEST NEXT ENTRY         EM003330
SATERRSW DC    X'00'                                                    EM003340
SATERRSV DC    F'0'                                                     EM003350
SATERR10 MVC   SATERRI+3(1),0(R2)       MOVE UNIT NUMBER TO ERROR CODE  EM003360
SATERR15 L     R2,SATERRSV              RESTORE R2                      EM003370
*********************************************************************** EM003380
*                                                                     * EM003390
*                        CALL TO TRANSIENT                            * EM003400
*                                                                     * EM003410
*********************************************************************** EM003420
         SVC   61                       PRINT DATA MANAGEMENT ERR MSG   EM003430
SATERRI  LA    0,616                    X'268' COMPLETION CODE - SAT ER EM003440
         ORG   *-2                                                      EM003450
         DROP  14                                                       EM003460
         DC    XL2'0568'                                                EM003470
         BALR  15,0                                                     EM003480
         ENDO                                                           EM003490
DSKTPERR DS    0H                                                       EM003500
         USING *,15                                                     EM003510
         MVI   DUMPSWT+1,X'00'                                          EM003520
         BALR  15,0                                                     EM003530
DSKTPCLS DS    0H                                                       EM003540
         USING *,15                                                     EM003550
         STM   0,14,SVAREA2                                             EM003560
         LA    13,SVAREA1                                               EM003570
         USING SVAREA1,13                                               EM003580
         DROP  15                                                       EM003590
         BALR  9,0                 NON-ZERO IN R9 TO FREE BUFRS AND CLS EM003600
         LA    11,RETURN                                                EM003610
         B     CLOSE                                                    EM003620
*                                                                       EM003630
         DROP  13                                                       EM003640
*                                                                       EM003650
*                                                                       EM003660
*  I/O REQUEST                                                          EM003670
*                                                                       EM003680
DSKTPIO  DS    0H                                                       EM003690
         USING *,15                                                     EM003700
         STM   0,14,SVAREA2                                             EM003710
         LA    13,SVAREA1                                               EM003720
         USING SVAREA1,13                                               EM003730
         DROP  15                                                       EM003740
         B     IOGO                                                     EM003750
*                                                                       EM003760
*                                                                       EM003770
*                                                                       EM003780
         DO    &D>0                                                     EM003790
SVAREA1  DC    18F'0'                                                   EM003800
         GOTO  .TPS1                                                    EM003810
         ENDO                                                           EM003820
SVAREA1  DS    0F                                                       EM003830
.TPS1    LABEL                                                          EM003840
*                                                                       EM003850
*                                                                       EM003860
*                                                                       EM003870
SVAREA2  DC    15F'0'                                                   EM003880
*                                                                       EM003890
*                                                                       EM003900
*                                                                       EM003910
CLOSE    L     10,=A(ODDBALL)                                           EM003920
         CLI   1(10),X'08'                                              EM003930
         BE    2(,10)              PHASE IS LOADED                      EM003940
         MVI   PHASEXPH,C'8'                                            EM003950
         LA    1,PHASEX                                                 EM003960
******** LOAD START                                                     EM003970
         LOAD  (1)                                                      EM003980
******** LOAD  END                                                      EM003990
         B     2(,10)                                                   EM004000
*                                                                       EM004010
*                                                                       EM004020
*                                                                       EM004030
LOADGO   STC   10,LOADGOA+1        PHASE NUMBER INTO CLI INSTR          EM004040
LOADGOA  CLI   PHASE,X'00'                                              EM004050
         BE    LOADGOB             PHASE IS LOADED                      EM004060
         STC   10,PHASE                                                 EM004070
         LA    1,PROG                                                   EM004080
******** LOAD  START                                                    EM004090
         LOAD  (1)                                                      EM004100
******** LOAD  END                                                      EM004110
LOADGOB  SRL   10,8                SHIFT OUT PH NO. - LEAVE ENTRY ADDR  EM004120
         L     12,=A(OVAREA)                                            EM004130
LOADGOX  SR    8,8                                                      EM004140
         BALR  11,10                                                    EM004150
RETURN   LM    0,14,SVAREA2                                             EM004160
DUMPSWT  BR    14                  NOP TO DUMP IF MAJOR ERROR           EM004170
******** CANCEL START                                                   EM004180
         CANCEL (0)                                                     EM004190
******** CANCEL END                                                     EM004200
*                                                                       EM004210
*                                                                       EM004220
*                                                                       EM004230
BASE26   DC    F'0'                                                     EM004240
*                                                                       EM004250
*                                                                       EM004260
*                                                                       EM004270
PROG     DS    0CL8                                                     EM004280
PROGNAME DC    CL6' '                                                   EM004290
         DC    C'0'                                                     EM004300
PHASE    DC    C' '                                                     EM004310
*                                                                       EM004320
*                                                                       EM004330
*                                                                       EM004340
PHASE1   DS    0F                 1ST HOUSEKEEPING - OPEN               EM004350
         DC    AL3(EMHK)                                                EM004360
         DC    C'4'                                                     EM004370
*                                                                       EM004380
PHASE2A  DS    0F                 2ND HOUSEKEEPING - IPL                EM004390
         DC    AL3(EMHK00)                                              EM004400
         DC    C'5'                                                     EM004410
*                                                                       EM004420
PHASE2B  DS    0F                 2ND HOUSEKEEPING - NO IPL             EM004430
         DC    AL3(EMHK00X)                                             EM004440
         DC    C'5'                                                     EM004450
*                                                                       EM004460
PHASE3   DS    0F                  PHASE3A AND PHASE3B WILL BE          EM004470
*                                    ACTUAL ENTRANCE POINTS IF          EM004480
*                                    CSECT 26 IS RESIDENT               EM004490
*                                                                       EM004500
PHASE3A  DS    0F                 DISK MONITOR EOJ                      EM004510
         DC    AL3(EOJ)                                                 EM004520
         DC    C'6'                                                     EM004530
*                                                                       EM004540
PHASE3B  DS    0F                 DISK MONITOR FETCH                    EM004550
         DC    AL3(FETCH)                                               EM004560
         DC    C'6'                                                     EM004570
*                                                                       EM004580
PHASE4   DS    0F                 DISK MOUNT                            EM004590
         DC    AL3(MOUNT)                                               EM004600
         DC    C'7'                                                     EM004610
*                                                                       EM004620
*                                                                       EM004630
*                                                                       EM004640
PHASEX   DS    0CL8                                                     EM004650
PHASEXNM DC    CL6' '                                                   EM004660
         DC    C'0'                                                     EM004670
PHASEXPH DC    C' '                1 IF ODD BALL RTNS - 8 IF CLOSE RTN  EM004680
*                                                                       EM004690
*                                                                       EM004700
         DO    &D>0                                                     EM004710
*                                                                       EM004720
*                                                                       EM004730
PHASE3X  DS    0F                                                       EM004740
         DC    AL3(EOJ)                                                 EM004750
         DC    C'6'                                                     EM004760
         DC    AL3(FETCH)                                               EM004770
         DC    C'6'                                                     EM004780
*                                                                       EM004790
         ENDO                                                           EM004800
         TITLE '360/20 DISC/TAPE EMULATOR - I/O REQUEST - &NNN'         EM004810
*                                                                       EM004820
*                                                                       EM004830
IOGO     SR    8,8                                                      EM004840
         DO    &D>0                                                     EM004850
IOGOX01  NOP   IOGOX05                 BRANCH IF MONITOR AREA IN USE    EM004860
         TM    E2$RAMOD,X'01'                                           EM004870
         BZ    IOGOX05                                                  EM004880
         OI    IOGOX01+1,X'F0'     SET MONITOR AREA IN USE SWITCH       EM004890
         SR    9,9                 ZERO IN R9 TO FREE BUFRS BUT NOT CLS EM004900
         BAL   11,CLOSE                                                 EM004910
         L     5,=A(BUFFER01)                                           EM004920
IOGOX02  LR    4,5                                                      EM004930
         L     5,BCBNBA                                                 EM004940
         LTR   5,5                                                      EM004950
         BZ    IOGOX03             LAST BUFFER                          EM004960
         CR    5,6                                                      EM004970
         BH    IOGOX02             NEXT BUFR NOT IN MONITOR AREA        EM004980
         XC    BCBNBA,BCBNBA       ZERO POINTER TO MONITOR AREA BUFR    EM004990
IOGOX03  STM   4,5,BUFSAVE         SAVE BUFR POINTERS FOR RESET         EM005000
         L     3,BASE26            SAVE EOJ/FETCH                       EM005010
         LM    4,5,PHASE3            LOAD ADDR AND                      EM005020
         STM   3,5,BUFSAVE+8         ENTRANCE ADDRS                     EM005030
         LTR   3,3                                                      EM005040
         BZ    IOGOX04                    EOJ/FETCH NOT RESIDENT        EM005050
         CR    3,6                                                      EM005060
         BNL   IOGOX04                   NOT LOADED IN MONITOR AREA     EM005070
         XC    BASE26,BASE26       SET UP LOAD ADDR                     EM005080
         LM    4,5,PHASE3X           AND ENTRANCE POINTS                EM005090
         STM   4,5,PHASE3            FOR NON-RESIDENT EOJ/FETCH         EM005100
IOGOX04  L     5,=A(BUFFER01)            ADDRESS OF 1ST BUFF TO R5      EM005110
         MVC   SORTSAVE,4(5)           SAVE BCBNBA OF FIRST BUFFER      EM005120
         XC    4(4,5),4(5)              BREAK STRING FOR SORT           EM005130
*                                                                       EM005140
.*                                                                      EM005150
.*                                                                      EM005160
.*                                                                      EM005170
.*                                                                      EM005180
.*                                                                      EM005190
.*                                                                      EM005200
.*                                                                      EM005210
.*                                                                      EM005220
.*                                                                      EM005230
.*                                                                      EM005240
.*                                                                      EM005250
.*                                                                      EM005260
.*                                                                      EM005270
.*                                                                      EM005280
.*                                                                      EM005290
.*                                                                      EM005300
.*                                                                      EM005310
.*                                                                      EM005320
.*                                                                      EM005330
.*                                                                      EM005340
IOGOX05  DS    0H                                                       EM005350
         ENDO                                                           EM005360
         CLI   E2$RAHIB,X'00'                                           EM005370
         BE    IOGOX05A            NO OUTSTANDING ERROR                 EM005380
         MVC   E2$RAPPS+6(2),=H'198'    SET 360-20 PSW TO GO TO EOJ     EM005390
         B     IOEXIT                                                   EM005400
IOGOX06  SR    1,1                      CLEAR R1                        EM005410
         IC    1,CCBLUB                 R1 = LUB DISPLACEMENT           EM005420
         AH    1,PGMSLUB                ADD 360/20 ADDR OF 1ST LUB      EM005430
         TM    0(1),X'80'               BRANCH IF THIS LUB IS INVALID   EM005440
         BO    IOGO01                     OR IS UNASSIGNED              EM005450
         LH    3,0(,1)                  R3 = PUB ADDRESS                EM005460
IOGOX07  DS    0H                                                       EM005470
         DO    &D>0                                                     EM005480
         CLI   0(3),X'08'               BRANCH IF THIS IS A DISC        EM005490
         BE    IOGO03                     OPERATION                     EM005500
         ENDO                                                           EM005510
         DO    &T>0                                                     EM005520
         CLI   0(3),X'07'               BRANCH IF THIS IS A TAPE        EM005530
         BE    IOGO02                     OPERATION                     EM005540
         ENDO                                                           EM005550
IOGO01   L     6,SVAREA2+24                                             EM005560
         MVC   E2$RAHIB(2),=X'0707'     LUB/PUB ERROR                   EM005570
         STH   9,E2$RAHIB+2                                             EM005580
         LA    15,IOGO01A                                               EM005590
         ST    15,E2$RAHIB+4                                            EM005600
         SVC   SV$E2C                                                   EM005610
IOGO01A  B     IOEXIT                                                   EM005620
IOGOX05A L     14,E2$RAPRE                                              EM005630
         DO    &D=0                                                     EM005640
         TM    E2$RATPS,X'02'                SCHEDULER A                EM005650
         BZ    PASTSCHA                      NO - BRANCH                EM005660
         L     R9,E2$RAPRF                   GET 360/20 R15             EM005670
         MVC   E2$RAPPS+6(2),E2$RAPRE        360/20 R14 TO PSW          EM005680
         AI    E2$RAPPS+6,X'04'              ADJUST PSW FORWARD BY 4    EM005690
         OI    X'9D',X'40'                                              EM005700
         MVC   E2$RAPRF+2(2),0(R0)           DUMMY CCB ADDRESS TO R15   EM005710
         B     IOGOARX                                                  EM005720
PASTSCHA EQU   *                                                        EM005730
         ENDO                                                           EM005740
         LH    9,0(,14)            CCB ADDR INTO R9                     EM005750
         LA    14,2(,14)           ADJUST RETURN ADDR                   EM005760
         ST    14,E2$RAPRE                                              EM005770
         MVC   E2$RAPPS+6(2),E2$RAPRE+2                                 EM005780
         DO    &D=0                                                     EM005790
IOGOARX  EQU   *                                                        EM005800
         ENDO                                                           EM005810
         TM    E2$RAMOD,X'02'                                           EM005820
         BZ    IOGOX06                                                  EM005830
         LA    3,CCBUNIT           LUB DISPL IS UNIT - 080X OR 078X     EM005840
         DO    (&D>0)**(&T>0)                                           EM005850
         TM    E2$RACUR+1,X'80'         BRANCH IF THIS IS A DISC XIO    EM005860
         BO    IOGO03                     OPERATION                     EM005870
         TM    E2$RACUR+1,X'70'         BRANCH IF THIS IS NOT A TAPE    EM005880
         BZ    IOGO01                     XIO OPERATIONIS NOT A TAPE    EM005890
         ENDO                                                           EM005900
*                                                                       EM005910
         DO    &T>0                                                     EM005920
IOGO02   LM    4,7,TAPECONS                                             EM005930
         DO    &D>0                                                     EM005940
         B     IOGO04                                                   EM005950
*                                                                       EM005960
         ENDO                                                           EM005970
         ENDO                                                           EM005980
         DO    &D>0                                                     EM005990
IOGO03   LM    4,7,DISKCONS                                             EM006000
         DO    &T>0                                                     EM006010
IOGO04   DS    0H                                                       EM006020
         ENDO                                                           EM006030
         ENDO                                                           EM006040
         LR    2,5                                                      EM006050
         CLI   1(3),X'00'          MAKE SURE DEVICE NOT ZERO            EM006060
         BE    IOGO01                                                   EM006070
IOGO05   CLI   0(5),X'00'                                               EM006080
         BNE   IOGO07              FOUND LAST ENTRY IN LIST             EM006090
         S     5,=F'4'                                                  EM006100
         CR    5,4                                                      EM006110
         BNL   IOGO05              NOT AT TOP OF LIST YET               EM006120
IOGO06   NI    CCBCOM,X'06'        INIT COMM BYTE                       EM006130
         ST    R9,IOGTEMP                    CCB ADDR INTO SAVE AREA    EM006140
         MVC   IOGTEMP(1),1(R3)              DEVICE INTO SAVE AREA      EM006150
         MVC   4(4,R5),IOGTEMP               ABOVE TWO INTO LIST        EM006160
         BR    6                   GO AWAKE TAPE OR DISK TASK           EM006170
IOGTEMP  DC    F'0'                          SAVE AREA FOR CCB ADDR     EM006180
*                                            AND DEVICE PRIOR TO        EM006190
*                                            ENTRY INTO LIST            EM006200
*                                                                       EM006210
IOGO07   CR    5,2                      IS LIST FULL                    EM006220
         BL    IOGO06                NO  - GO PUT ENTRY IN LIST         EM006230
         BR    7                     YES - GO AWAIT TAPE OR DISK TASK   EM006240
*                                                                       EM006250
         DO    &T>0                                                     EM006260
IONOTAPE TM    TAPEECB+2,X'80'                                          EM006270
         BZ    IONOTAPE                                                 EM006280
         B     IOGO02                                                   EM006290
*                                                                       EM006300
IOGOTAPE L     6,SVAREA2+24                                             EM006310
         TM    E2$RAMOD,X'04'                                           EM006320
         BO    IOTAPE                                                   EM006330
******** AWAKE START                                                    EM006340
         AWAKE TAPEECB                                                  EM006350
******** AWAKE END                                                      EM006360
         DO    &D>0                                                     EM006370
         B     IOEXIT                                                   EM006380
*                                                                       EM006390
         ENDO                                                           EM006400
         ENDO                                                           EM006410
         DO    &D>0                                                     EM006420
IONODISK TM    DISKECB+2,X'80'                                          EM006430
         BZ    IONODISK                                                 EM006440
         B     IOGO03                                                   EM006450
*                                                                       EM006460
IOGODISK L     6,SVAREA2+24                                             EM006470
         TM    E2$RAMOD,X'04'                                           EM006480
         BO    IODISK                                                   EM006490
******** AWAKE START                                                    EM006500
         AWAKE DISKECB                                                  EM006510
******** AWAKE END                                                      EM006520
         ENDO                                                           EM006530
IOEXIT   LM    0,14,SVAREA2                                             EM006540
         BR    14                                                       EM006550
*                                                                       EM006560
*                                                                       EM006570
         DO    &T=0                                                     EM006580
TAPEECB  DS    0F                                                       EM006590
         ENDO                                                           EM006600
         DO    &D=0                                                     EM006610
DISKECB  DS    0F                                                       EM006620
         ENDO                                                           EM006630
         DO    &T>0                                                     EM006640
******** ECB   START                                                    EM006650
TAPEECB  ECB                                                            EM006660
******** ECB   END                                                      EM006670
*                                                                       EM006680
*                                                                       EM006690
TAPECONS DC    A(TAPELIST)         INTO GPR 4 WITH LM IF TAPE           EM006700
         DC    A(ENDTLIST)                  5                           EM006710
         DC    A(IOGOTAPE)                  6                           EM006720
         DC    A(IONOTAPE)                  7                           EM006730
*                                                                       EM006740
*                                                                       EM006750
         ENDO                                                           EM006760
         DO    &D>0                                                     EM006770
******** ECB   START                                                    EM006780
DISKECB  ECB                                                            EM006790
******** ECB   END                                                      EM006800
*                                                                       EM006810
*                                                                       EM006820
DISKCONS DC    A(DISKLIST)         INTO GPR 4 WITH LM IF DISK           EM006830
         DC    A(ENDDLIST)                  5                           EM006840
         DC    A(IOGODISK)                  6                           EM006850
         DC    A(IONODISK)                  7                           EM006860
*                                                                       EM006870
*                                                                       EM006880
BUFSAVE  DC    5F'0'                                                    EM006890
*                                                                       EM006900
SORTSAVE DC    F'0'                    SAVE AREA FOR BCBNBA OF 1ST BUFF EM006910
*                                                                       EM006920
         ENDO                                                           EM006930
         DO    &T>0                                                     EM006940
         DS    0F                                                       EM006950
         DC    XL4'FFFFFFFF'                                            EM006960
         DO    &T=1                                                     EM006970
TAPLST   DS    0CL12                                                    EM006980
         ENDO                                                           EM006990
         DO    &T=2                                                     EM007000
TAPLST   DS    0CL16                                                    EM007010
         ENDO                                                           EM007020
         DO    &T=3                                                     EM007030
TAPLST   DS    0CL20                                                    EM007040
         ENDO                                                           EM007050
         DO    &T=4                                                     EM007060
TAPLST   DS    0CL24                                                    EM007070
         ENDO                                                           EM007080
         DO    &T=5                                                     EM007090
TAPLST   DS    0CL28                                                    EM007100
         ENDO                                                           EM007110
         DO    &T=6                                                     EM007120
TAPLST   DS    0CL32                                                    EM007130
         ENDO                                                           EM007140
TAPELIST DS    0F                                                       EM007150
         DC    F'0'                                                     EM007160
         DC    F'0'                                                     EM007170
&W       SET   &T-1                                                     EM007180
         DO    &W                                                       EM007190
         DC    F'0'                                                     EM007200
         ENDO                                                           EM007210
ENDTLIST DC    F'0'                                                     EM007220
*                                                                       EM007230
*                                                                       EM007240
         ENDO                                                           EM007250
         DO    &D>0                                                     EM007260
         DS    0F                                                       EM007270
         DC    XL4'FFFFFFFF'                                            EM007280
         DO    &D=1                                                     EM007290
DSKLST   DS    0CL8                                                     EM007300
         ENDO                                                           EM007310
         DO    &D=2                                                     EM007320
DSKLST   DS    0CL16                                                    EM007330
         ENDO                                                           EM007340
         DO    &D=3                                                     EM007350
DSKLST   DS    0CL24                                                    EM007360
         ENDO                                                           EM007370
         DO    &D=4                                                     EM007380
DSKLST   DS    0CL32                                                    EM007390
         ENDO                                                           EM007400
         DO    &D=5                                                     EM007410
DSKLST   DS    0CL40                                                    EM007420
         ENDO                                                           EM007430
         DO    &D=6                                                     EM007440
DSKLST   DS    0CL48                                                    EM007450
         ENDO                                                           EM007460
         DO    &D=7                                                     EM007470
DSKLST   DS    0CL56                                                    EM007480
         ENDO                                                           EM007490
         DO    &D=8                                                     EM007500
DSKLST   DS    0CL64                                                    EM007510
         ENDO                                                           EM007520
DISKLIST DC    F'0'                                                     EM007530
&W       SET   &D-1                                                     EM007540
         DO    &W                                                       EM007550
         DC    2F'0'                                                    EM007560
         ENDO                                                           EM007570
ENDDLIST DC    F'0'                                                     EM007580
*                                                                       EM007590
*                                                                       EM007600
FETADDRS DC    2F'0'                                                    EM007610
*                                                                       EM007620
*                                                                       EM007630
         ENDO                                                           EM007640
         DO    &T>0                                                     EM007650
         TITLE '360/20 DISC/TAPE EMULATOR - TAPE TASK - &NNN'           EM007660
*                                                                       EM007670
*                                                                       EM007680
IOTAPE   LA    5,TAPELIST                                               EM007690
         LA    7,ENDTLIST                                               EM007700
IOT001   CLI   0(5),X'00'          SCAN CCB LIST FOR ACTIVE ENTRY -     EM007710
         BNE   IOT002                   FOUND                           EM007720
         CR    5,7                                                      EM007730
         BNL   IOTEND              END OF LIST                          EM007740
         LA    5,4(,5)                                                  EM007750
         B     IOT001              GO CHECK NEXT ITEM                   EM007760
*                                                                       EM007770
IOT002   L     9,0(,5)             CCB ADDR INTO R9                     EM007780
         LA    9,0(,9)             ZERO HIGH ORDER BYTE IN R9           EM007790
         L     2,=A(TPADDRS)       POINT R1 TO WORK                     EM007800
IOT003   CLC   0(1,5),0(2)           AREA AND MACROS                    EM007810
         BE    IOT004                  FOR THIS DRIVE                   EM007820
         CLI   0(2),X'00'                                               EM007830
         BE    IOT003A             DRIVE NOT FOUND                      EM007840
         LA    2,8(,2)                                                  EM007850
         B     IOT003                                                   EM007860
*                                                                       EM007870
IOT003A  MVC   PGMUNIT,0(5)                                             EM007880
         MVC   E2$RAHIB(2),=X'0701'                                     EM007890
         SR    9,9                                                      EM007900
         B     IOT012                                                   EM007910
*                                                                       EM007920
IOT004   L     3,0(,2)             POINTER TO CCB INTO R3               EM007930
         LA    3,0(,3)             CLEAR HI ORDER BYTE                  EM007940
         MVC   IOT006A+1(1),4(2)   SET UP OI AND NI INSTRUCTIONS        EM007950
         MVC   IOT006B+1(1),5(2)     FOR MODE SET COMMAND               EM007960
         XC    CCBTRBC,CCBTRBC     INIT RESIDUAL BYTE COUNT             EM007970
         MVC   IOTWORK,CCBCCW      ADDR OF 360/20                       EM007980
         LH    2,IOTWORK             CCW INTO R2                        EM007990
IOT004A  CLI   0(2),X'08'          1ST CC MUST                          EM008000
         BE    IOT011                NOT BE TIC                         EM008010
IOT005   CLC   2(2,2),=X'0090'                                          EM008020
         BL    IOT011              ERROR IF DATA ADDR BELOW 144         EM008030
         MVC   IOTWORK,2(2)          OR ABOVE                           EM008040
         LH    1,IOTWORK               360/20                           EM008050
         CR    1,6                       HIGH                           EM008060
         BNL   IOT011                      ADDR                         EM008070
         CLI   0(2),X'08'                                               EM008080
         BNE   IOT005C             GO CHECK COUNT IF NOT TIC            EM008090
         LR    2,1                 DATA ADDR BECOMES ADDR OF CCW        EM008100
         B     IOT004A             GO MAKE SURE TIC NOT TO ANOTHER TIC  EM008110
*                                                                       EM008120
IOT005C  MVC   IOTWORK,4(2)                                             EM008130
         NI    IOTWORK,X'0F'                                            EM008140
         CLC   IOTWORK,=X'0000'                                         EM008150
         BE    IOT011              ERROR IF BYTE COUNT ZERO             EM008160
         TM    0(2),X'03'                                               EM008170
         BO    IOT005G             CONTROL                              EM008180
         CLI   0(2),X'0C'                                               EM008190
         BNE   IOT005F             GO ADD COUNT TO ADDR IF NOT RD BACK  EM008200
         MVI   IOTWMT,X'40'             SET READ BACKWARD BIT IN BCW    EM008210
         SH    1,IOTWORK           ERROR IF DATA                        EM008220
         CH    1,=H'143'             WOULD EXTEND                       EM008230
         BL    IOT011                  BELOW 144                        EM008240
         AH    1,IOTWORK                                                EM008250
         B     IOT005G                                                  EM008260
IOT005F  TM    0(2),X'01'               BRANCH IF THIS IS A WRITE       EM008270
         BO    IOT005J                    COMMAND CODE                  EM008280
         MVI   IOTWMT,X'00'             SET READ BIT IN BCW             EM008290
         B     IOT005K                  GO TO TEST CORE SIZE            EM008300
IOT005J  MVI   IOTWMT,X'80'             SET WRITE BIT IN BCW            EM008310
IOT005K  AH    1,IOTWORK           ERROR IF DATA                        EM008320
         CR    1,6                   WOULD EXTEND                       EM008330
         BH    IOT011                  ABOVE HIGH CORE                  EM008340
         SH    1,IOTWORK                                                EM008350
IOT005G  ST    1,IOTCCW            DATA ADDR INTO CCW                   EM008360
         NI    IOTCCW+1,X'77'           CLEAR BCW KEY BITS              EM008370
         MVC   IOTCCW(1),0(2)      CC INTO CCW                          EM008380
         XC    IOTCCW+4(12),IOTCCW+4    CLEAR BCW BYTES 5 THROUGH 16    EM008390
         CLI   0(2),X'04'                                               EM008400
         BNE   IOT005H             NOT SENSE                            EM008410
         MVI   IOTWMT,X'00'             SET READ BIT IN BCW (SENSE)     EM008420
         ST    1,IOTSVXA                                                EM008430
         NI    IOT009A+1,X'0F'                                          EM008440
         MVC   IOTCCW+4(2),=X'0005'     FORCE BYTE COUNT 5 IF SENSE     EM008450
         B     IOT005I                                                  EM008460
*                                                                       EM008470
IOT005H  MVC   IOTCCW+4(2),IOTWORK      BYTE COUNT TO CCW               EM008480
IOT005I  MVC   IOTCCW+6(2),=X'0001'     SET BLOCK SIZE = 1              EM008490
         TM    IOTCCW,X'03'                                             EM008500
         BNO   IOT006C             NOT MODE SET                         EM008510
         TM    IOTCCW,X'04'                                             EM008520
         BO    IOT006C             NOT MODE SET                         EM008530
*  THE FOLLOWING TWO INSTRUCTIONS WILL CLEAR UNUSED BITS AND ENSURE THE EM008540
*    TWO HIGH ORDER BITS ARE ON IN MODE SET COMMAND CODES FOR 9-TRACK   EM008550
*    TAPE DRIVES.  THERE WILL BE NO CHANGE FOR 7-TRACK TAPE DRIVES.     EM008560
         B     IOT006Z                  DO NOT EXECUTE MODE             EM008570
IOT006A  OI    IOTCCW,X'C0'        X'00' IF 7-TRK                       EM008580
IOT006B  NI    IOTCCW,X'CF'        X'FF' IF 7-TRK                       EM008590
IOT006C  LR    1,3                                                      EM008600
         TM    E2$RAMOD,X'04'                                           EM008610
         BZ    *+12                                                     EM008620
         TM    2(1),X'80'                                               EM008630
         BZ    *-4                                                      EM008640
******** WAIT  START                                                    EM008650
         WAIT  (1)                                                      EM008660
******** WAIT  END                                                      EM008670
         OC    IOTCCW+6(1),IOTWMT       INSERT THE WMT BITS INTO BCW    EM008680
         LR    1,3                                                      EM008690
IOTEXCP  EQU   *                                                        EM008700
******** EXCP  START                                                    EM008710
         EXCP  (1)                                                      EM008720
******** EXCP  END                                                      EM008730
         TM    IOTCCW,X'03'        GO TO WAIT                           EM008740
         BNO   IOT007                IF NOT                             EM008750
IOT006Z  EQU   *                                                        EM008760
         TM    1(2),X'80'              CONTROL                          EM008770
         BO    IOT007                    W/O CHAIN                      EM008780
         TM    CCBCOM,X'04'                                             EM008790
         BO    IOT007              DE SIGNIFICANT                       EM008800
         MVI   CCBUSTAT,X'08'      SET CE BIT ON                        EM008810
         B     IOT009              GO MARK CCB COMPLETE                 EM008820
*                                                                       EM008830
IOT007   LR    1,3                                                      EM008840
         TM    E2$RAMOD,X'04'                                           EM008850
         BZ    *+12                                                     EM008860
         TM    2(1),X'80'                                               EM008870
         BZ    *-4                                                      EM008880
******** WAIT  START                                                    EM008890
         WAIT  (1)                                                      EM008900
******** WAIT  END                                                      EM008910
         TM    2(R1),X'20'                   UNIQUE ERROR               EM008920
         BO    IOTEXCP                       YES - BRANCH               EM008930
         MVI   CCBUSTAT,X'0C'      SET CE AND DE BITS ON                EM008940
         TM    2(3),X'08'                                               EM008950
         BZ    IOT008                                                   EM008960
         OI    CCBUSTAT,X'01'      SET UNIT EXCEPTION BIT ON            EM008970
         OI    CCBCOM,X'80'             SET INCORRECT LENGTH BIT ON     EM008975
         B     IOT009A                                                  EM008980
*                                                                       EM008990
IOT008   CLC   10(2,3),=XL2'00'                                         EM009000
         BE    IOT009A             NO RESIDUAL                          EM009010
         TM    IOTCCW,X'03'                                             EM009020
         BO    IOT009A             CONTROL                              EM009030
         MVC   CCBTRBC,10(3)       RESIDUAL TO CCB                      EM009040
         OI    CCBCOM,X'80'        SET INCORRECT LENGTH BIT ON          EM009050
         MVC   CCBTRBC,10(3)            RESIDUAL COUNT TO CCB           EM009051
         B     IOT009                                                   EM009060
*                                                                       EM009070
IOT009A  B     IOT009B             NOP IF SENSE                         EM009080
         OI    IOT009A+1,X'F0'                                          EM009090
         L     1,IOTSVXA                                                EM009100
         MVI   2(1),X'03'                                               EM009110
IOT009B  TM    1(2),X'80'                                               EM009120
         BZ    IOT009              NO CHAIN                             EM009130
         LA    2,6(,2)             STEP TO NEXT 360/20 CCW              EM009140
         B     IOT005                                                   EM009150
*                                                                       EM009160
IOT009   OI    CCBCOM,X'40'        MARK CCB COMPLETE                    EM009170
         STH   R2,PGMCCWAD                                              EM009175
         MVI   0(5),X'00'          MARK LIST ENTRY INACTIVE             EM009180
         CR    5,7                                                      EM009190
         BNL   IOTEND              END OF LIST                          EM009200
         LR    2,5                                                      EM009210
IOT010   MVC   0(4,2),4(2)         COMPRESS LIST                        EM009220
         LA    2,4(,2)                                                  EM009230
         CR    2,7                                                      EM009240
         BL    IOT010              NOT END OF LIST                      EM009250
         B     IOT001              GO LOOK FOR ANOTHER ACTIVE ENTRY     EM009260
*                                                                       EM009270
IOT011   MVC   E2$RAHIB(2),=X'0703'                                     EM009280
         STH   2,PGMCCWAD                                               EM009290
IOT012   STH   9,E2$RAHIB+2                                             EM009300
         XC    TAPLST,TAPLST                                            EM009310
         LA    15,IOTEND                                                EM009320
         ST    15,E2$RAHIB+4                                            EM009330
*********************************************************************** EM009340
*                                                                     * EM009350
*                        CALL TO TRANSIENT                            * EM009360
*                                                                     * EM009370
*********************************************************************** EM009380
         SVC   SV$E2C                                                   EM009390
IOTEND   TM    E2$RAMOD,X'04'                                           EM009400
         BO    IOEXIT                                                   EM009410
******** TYIELD START                                                   EM009420
         TYIELD                                                         EM009430
******** TYIELD END                                                     EM009440
         B     IOTAPE                                                   EM009450
*                                                                       EM009460
IOTWORK  DC    H'0'                                                     EM009470
IOTSVXA  DC    F'0'                                                     EM009480
*                                                                       EM009490
         CNOP  0,8                                                      EM009500
IOTCCW   DC    4F'0'                    90/30 BUFFER CONTROL WORD       EM009510
IOTWMT   DC    X'00'                    BCW WMT BIT HOLDER              EM009520
*                                                                       EM009530
         ENDO                                                           EM009540
         DO    &D>0                                                     EM009550
         TITLE '360/20 DISC/TAPE EMULATOR - DISC TASK - &NNN'           EM009560
*                                                                       EM009570
*                                                                       EM009580
IODISK   LA    5,DISKLIST                                               EM009590
         LA    7,ENDDLIST                                               EM009600
IOD001   CLI   0(5),X'00'          SCAN CCB LIST FOR ACTIVE ENTRY -     EM009610
         BNE   IOD002                   FOUND                           EM009620
         CR    5,7                                                      EM009630
         BNL   IODEND              END OF LIST                          EM009640
         LA    5,4(,5)                                                  EM009650
         B     IOD001                                                   EM009660
*                                                                       EM009670
IOD002   ST    5,IODSVR5                                                EM009680
         L     9,0(,5)             CCB ADDR INTO R9                     EM009690
         LA    9,0(,9)             ZERO HIGH ORDER BYTE IN R9           EM009700
         L     7,=A(XIO1)          POINT R7 TO                          EM009710
IOD002A  CLC   0(1,5),0(7)           XIO TABLE                          EM009720
         BE    IOD003                  FOR THIS DRIVE                   EM009730
         CLI   0(7),X'00'                                               EM009740
         BE    IOD002B             DRIVE NOT FOUND                      EM009750
         LA    7,28(,7)                                                 EM009760
         B     IOD002A                                                  EM009770
*                                                                       EM009780
IOD002B  LA    0,1                                                      EM009790
         B     DISKERRX            INVALID LUB/PUB                      EM009800
*                                                                       EM009810
IOD003   TM    XIOSWT,X'80'                                             EM009820
         BZ    IOD002B                                                  EM009830
         LH    5,CCBCCW            ADDR OF CCW INTO R5                  EM009840
IOD003A  LA    1,IODCCTBL-1                                             EM009850
         SR    2,2                                                      EM009860
IOD004   LA    1,1(,1)                                                  EM009870
         LA    2,4(,2)                                                  EM009880
         CLC   CCWCC,0(1)          VALIDATE COMMAND CODE AND            EM009890
         BE    IOD005-4(2)           BRANCH TO ROUTINE                  EM009900
         CLI   0(1),X'FF'                                               EM009910
         BNE   IOD004                                                   EM009920
         B     DISKERR             INVALID COMMAND                      EM009930
*                                                                       EM009940
IOD005   B     SEEK                SEEK                                 EM009950
         B     RDDATA              READ DATA                            EM009960
         B     WRDATA              WRITE DATA                           EM009970
         B     SCANHEQ             SCAN HIGH OR EQUAL                   EM009980
         B     SCANEQ              SCAN EQUAL                           EM009990
         B     SCANLEQ             SCAN LOW OR EQUAL                    EM010000
         B     SENSE               SENSE                                EM010010
         B     RDCTDTA             READ COUNT AND DATA                  EM010020
         B     WRCTDTA             WRITE COUNT AND DATA                 EM010030
         B     VERDTA              VERIFY DATA                          EM010040
         B     VERCTDTA            VERIFY COUNT AND DATA                EM010050
         B     RDCOUNT             READ COUNT                           EM010060
         B     RECAL               RECALIBRATE                          EM010070
         B     IOD006A             NOP                                  EM010080
*                                                                       EM010090
*  COMMON RETURN POINT                                                  EM010100
*                                                                       EM010110
IOD006   OI    XIOUSTAT,X'0C'      SET ON CHANNEL END AND DEVICE END    EM010120
         TM    XIOUSTAT,X'02'                                           EM010130
         BO    IOD006B             UNIT CHECK                           EM010140
IOD006A  TM    CCWCFLG,X'80'                                            EM010150
         BZ    IOD007              NO CHAIN OR END OF CHAIN             EM010160
         MVC   IODWRKX,1(5)        SKIP VERIFY DATA                     EM010170
         NI    IODWRKX1,X'7F'        OR VERIFY COUNT                    EM010180
         NI    IODWRKX2,X'7F'        AND DATA IF                        EM010190
         CLC   IODWRKX1,IODWRKX2     FOLLOWING WRITE                    EM010200
         BNE   IOD006A2              DATA OR WRITE                      EM010210
         MVC   IODWORK1,0(5)         COUNT AND DATA                     EM010220
         MVC   IODWORK2,6(5)         AND SECTOR                         EM010230
         CLC   IODWORK,=X'0141'      COUNT AND                          EM010240
         BE    IOD006A1              COUNT AND                          EM010250
         CLC   IODWORK,=X'11C1'      DATA ADDRS                         EM010260
         BNE   IOD006A2              ARE EQUAL                          EM010270
IOD006A1 MVC   XIOCC,6(5)                                               EM010280
         LA    5,6(,5)                                                  EM010290
         B     IOD006A                                                  EM010300
*                                                                       EM010310
IOD006A2 LA    5,6(,5)                                                  EM010320
         B     IOD003A             GO PROCESS NEXT CCW                  EM010330
*                                                                       EM010340
IOD006B  LR    2,5                 PUT ERROR CCW                        EM010350
         MVC   IODWORK,CCBCCW        DISPLACEMENT                       EM010360
         SH    2,IODWORK             FROM ORIGINAL                      EM010370
         STC   2,CCBBYTE4            CCW INTO CCB                       EM010380
         TM    CCBCOM,X'02'                                             EM010390
         BZ    IOD007A             ACCEPT DISK ERROR BIT NOT SET        EM010400
         MVC   CCBDSB,XIOSSTAT     SENSE BYTE TO CCB                    EM010410
         MVC   CCBDRSC,XIOSECTR    RESIDUAL SECTOR COUNT TO CCB         EM010420
         B     IOD007A                                                  EM010430
*                                                                       EM010440
IOD007   MVI   CCBBYTE4,X'00'      SET CCB BYTE 4 TO ZERO               EM010450
IOD007A  MVC   CCBUSTAT,XIOUSTAT   SET UNIT STATUS IN CCB               EM010460
         OI    CCBCOM,X'40'        SET WAIT BIT IN CCB                  EM010470
         L     5,IODSVR5                                                EM010480
         LA    7,ENDDLIST                                               EM010490
         MVI   0(5),X'00'          MARK CCB LIST ENTRY INACTIVE         EM010500
         CR    5,7                                                      EM010510
         BNL   IODEND              END OF LIST                          EM010520
         LR    2,5                                                      EM010530
IOD008   MVC   0(4,2),4(2)         COMPRESS LIST                        EM010540
         LA    2,4(,2)                                                  EM010550
         CR    2,7                                                      EM010560
         BL    IOD008              NOT END OF LIST                      EM010570
         B     IOD001              GO LOOK FOR ANOTHER ACTIVE ENTRY     EM010580
*                                                                       EM010590
*                                                                       EM010600
*                                                                       EM010610
DISKERR  LA    0,3                                                      EM010620
DISKERRX STH   0,E2$RAHIB                                               EM010630
         MVI   E2$RAHIB,X'08'                                           EM010640
         STH   9,E2$RAHIB+2                                             EM010650
         CLI   E2$RAHIB+1,X'01'                                         EM010660
         BE    DISKERRY                                                 EM010670
         STH   5,PGMCCWAD                                               EM010680
         B     DISKERRZ                                                 EM010690
*                                                                       EM010700
DISKERRY MVC   PGMUNIT,0(5)                                             EM010710
DISKERRZ XC    DSKLST,DSKLST                                            EM010720
         LA    15,IODEND                                                EM010730
         ST    15,E2$RAHIB+4                                            EM010740
*********************************************************************** EM010750
*                                                                     * EM010760
*                        CALL TO TRANSIENT                            * EM010770
*                                                                     * EM010780
*********************************************************************** EM010790
         SVC   SV$E2C                                                   EM010800
IODEND   TM    E2$RAMOD,X'04'                                           EM010810
         BO    IOEXIT                                                   EM010820
******** TYIELD START                                                   EM010830
PUTEND   TYIELD                                                         EM010840
******** TYIELD END                                                     EM010850
PUTSWT   B     IODISK              NOP TO PUT WITH VERIFY FROM TASK     EM010860
         OI    PUTSWT+1,X'F0'                                           EM010870
         LM    0,1,PUTREGS+8                                            EM010880
******** PUT?  START                                                    EM010890
         PUT?  (1),(0)                                                  EM010900
******** PUT?  END                                                      EM010910
         B     PUTEND                                                   EM010920
*                                                                       EM010930
PUTREGS  DC    5F'0'                                                    EM010940
*                                                                       EM010950
IODWORK  DS    0H                                                       EM010960
IODWORK1 DC    X'00'                                                    EM010970
IODWORK2 DC    X'00'                                                    EM010980
*                                                                       EM010990
IODWRKX  DS    0CL11                                                    EM011000
IODWRKX1 DC    XL5'00'                                                  EM011010
         DC    X'00'                                                    EM011020
IODWRKX2 DC    XL5'00'                                                  EM011030
*                                                                       EM011040
IODSVR5  DC    F'0'                                                     EM011050
*                                                                       EM011060
IODCCTBL DS    0CL14               LIST OF VALID COMMAND CODES          EM011070
         DC    X'03'          SEEK                                      EM011080
         DC    X'02'          READ DATA                                 EM011090
         DC    X'01'          WRITE DATA                                EM011100
         DC    X'71'          SCAN HIGH OR EQUAL                        EM011110
         DC    X'61'          SCAN EQUAL                                EM011120
         DC    X'51'          SCAN LOW OR EQUAL                         EM011130
         DC    X'04'          SENSE                                     EM011140
         DC    X'12'          READ COUNT AND DATA                       EM011150
         DC    X'11'          WRITE COUNT AND DATA                      EM011160
         DC    X'41'          VERIFY DATA                               EM011170
         DC    X'C1'          VERIFY COUNT AND DATA                     EM011180
         DC    X'32'          READ COUNT                                EM011190
         DC    X'0B'          RECALIBRATE                               EM011200
         DC    X'FF'          NOP  -  MUST BE LAST ENTRY IN LIST        EM011210
*                                                                       EM011220
         EJECT                                                          EM011230
*                                                                       EM011240
*                                                                       EM011250
*  SEEK ROUTINE                                                         EM011260
*                                                                       EM011270
SEEK     BAL   14,VALDA            VALIDATE AND SAVE DATA FIELD ADDR    EM011280
         LA    0,5(,1)                                                  EM011290
         CR    0,6                                                      EM011300
         BNL   DISKERR             ADDR ABOVE 360-20 PGM                EM011310
         CLI   3(1),X'CA'          DATA FIELD ADDR IN R1                EM011320
         BH    DISKERR             CYL GREATER THAN 202                 EM011330
         CLI   5(1),X'09'                                               EM011340
         BH    DISKERR             TRK GREATER THAN 9                   EM011350
         MVC   XIOICCYL,3(1)       SAVE CYL                             EM011360
         MVC   XIOICTRK,5(1)         AND                                EM011370
         MVC   XIOUCTRK,5(1)           TRK                              EM011380
SEEK001  MVC   XIOCC,CCWCC         SAVE COMMAND CODE                    EM011390
         XC    XIOSTATS,XIOSTATS   SET STATUS BYTES TO ZERO             EM011400
         B     IOD006              TO COMMON END OF COMMAND RTN         EM011410
*                                                                       EM011420
         EJECT                                                          EM011430
*                                                                       EM011440
*                                                                       EM011450
*  READ AND WRITE DATA ROUTINE                                          EM011460
*                                                                       EM011470
*  HANDLE VERIFY DATA SAME AS WRITE DATA                                EM011480
*                                                                       EM011490
VERDTA   DS    0H                                                       EM011500
WRDATA   LA    1,MOVEFR20          SAVE ADDR OF MOVE FR 360/20 SUBRTN   EM011510
         B     RDWR001                                                  EM011520
*                                                                       EM011530
RDDATA   LA    1,MOVETO20          SAVE ADDR OF MOVE TO 360/20 SUBRTN   EM011540
RDWR001  ST    1,RDWRFRTO                                               EM011550
         BAL   14,VALSECT          VALIDATE AND SAVE SECTOR COUNT       EM011560
         BAL   14,VALCFADA         VALIDATE AND SAVE CNT AND DATA ADDRS EM011570
         BAL   14,SETHDREC         VALIDATE AND SAVE TRK AND REC        EM011580
         MVC   XIOCC,CCWCC         SAVE COMMAND CODE                    EM011590
         XC    XIOSTATS,XIOSTATS   SET STATUS BYTES TO ZERO             EM011600
RDWR002  BAL   14,GETBUFR          GET BUFFER                           EM011610
RDWR003  L     1,RDWRFRTO          MOVE SECTOR TO OR                    EM011620
         BALR  14,1                  FROM 360/20 PGM                    EM011630
         BAL   14,DECCNT           DECRAMENT SECTOR COUNT               EM011640
         BZ    IOD006              LAST SECTOR - GO TO COMMON END RTN   EM011650
         BAL   14,STEPTR           STEP TRK AND REC                     EM011660
         BAL   14,STEPDCA          STEP DATA AND COUNT ADDRS            EM011670
         CLI   XIOUCREC,X'05'      GO GET A BUFFER                      EM011680
         BE    RDWR002               IF RECORD NUMBER                   EM011690
         CLI   XIOUCREC,X'00'          IS 5 OR ZERO -                   EM011700
         BE    RDWR002                   START OF NEW BLOCK             EM011710
         L     2,BCBRECAD          STEP RECORD                          EM011720
         LA    2,270(,2)             ADDR WITHIN                        EM011730
         ST    2,BCBRECAD              SAME BLOCK                       EM011740
         B     RDWR003             GO MOVE NEXT SECTOR                  EM011750
*                                                                       EM011760
RDWRFRTO DC    F'0'                                                     EM011770
*                                                                       EM011780
         EJECT                                                          EM011790
*                                                                       EM011800
*                                                                       EM011810
*  SCAN ROUTINE                                                         EM011820
*                                                                       EM011830
SCANLEQ  NI    SCNBR+1,X'0F'       SCAN LOW OR EQUAL - SET BR INSTR     EM011840
         OI    SCNBR+1,X'40'         TO BRANCH LOW                      EM011850
         B     SCAN                GO TO COMMON SCAN ROUTINE            EM011860
*                                                                       EM011870
SCANEQ   NI    SCNBR+1,X'0F'       SCAN EQUAL - SET BR INSTR TO NOP     EM011880
         B     SCAN                GO TO COMMON SCAN ROUTINE            EM011890
*                                                                       EM011900
SCANHEQ  NI    SCNBR+1,X'0F'       SCAN HIGH OR EQUAL - SET BR INSTR    EM011910
         OI    SCNBR+1,X'20'         TO BRANCH HIGH                     EM011920
SCAN     L     11,=A(ODDBALL)                                           EM011930
         USING ODDBALL,11                                               EM011940
         BAL   14,VALSECT          VALIDATE AND SAVE SECTOR COUNT       EM011950
         BAL   14,VALCFADA         VALIDATE AND SAVE CNT AND DATA ADDRS EM011960
         LA    0,269(,1)                                                EM011970
         CR    0,6                                                      EM011980
         BNL   DISKERR             ADDR ABOVE 360-20 PGM                EM011990
         L     1,XIOCOUNT                                               EM012000
         LA    0,8(,1)                                                  EM012010
         CR    0,6                                                      EM012020
         BNL   DISKERR             ADDR ABOVE 360-20 PGM                EM012030
         BAL   14,SETHDREC         VALIDATE AND SAVE TRK AND REC        EM012040
         MVC   XIOCC,CCWCC         SAVE COMMAND CODE                    EM012050
         XC    XIOSTATS,XIOSTATS   SET STATUS BYTES TO ZERO             EM012060
         NI    SCNSWT1+1,X'0F'     INIT SPLIT KEY SWT                   EM012070
         XC    SMASK1,SMASK1       INIT MASK                            EM012080
         MVC   SMASK2(180),SMASK1    TO ZERO                            EM012090
         L     1,XIODATA           SET R1 TO DATA FIELD                 EM012100
         LA    2,SMASK             SET R2 TO MASK FIELD                 EM012110
         SR    3,3                 INIT DISPLACEMENT FOR CMP TO ZERO    EM012120
         LA    0,270(,1)           PUT LIMIT INTO R0                    EM012130
SCN001   CLI   0(1),X'FF'          CMP DATA BYTE                        EM012140
         BNE   SCNSWT1                                                  EM012150
         MVI   0(2),X'FF'          SET MASK BYTE                        EM012160
SCN002   LA    1,1(,1)             STEP DATA ADDR                       EM012170
         LA    2,1(,2)             STEP MASK ADDR                       EM012180
         LA    3,1(,3)             STEP DISPLACEMENT                    EM012190
         CR    1,0                 CMP DATA ADDR TO LIMIT               EM012200
         BL    SCN001              CHK NEXT BYTE                        EM012210
         OI    SCNSWT2+1,X'F0'     CANT USE ONE CMP IF END LOOP HERE    EM012220
         NI    SCNSWT3+1,X'0F'     INIT SWTS TO                         EM012230
         NI    SCNSWT4+1,X'0F'       MOVE AND CMP                       EM012240
         NI    SCNSWT5+1,X'0F'         THREE TIMES                      EM012250
         CLI   SMASK1,X'FF'                                             EM012260
         BNE   SCN003                                                   EM012270
         CLC   SMASK1+1(89),SMASK1                                      EM012280
         BNE   SCN003                                                   EM012290
         OI    SCNSWT3+1,X'F0'     DONT DO 1ST CMP - MASK ALL FF        EM012300
SCN003   CLI   SMASK2,X'FF'                                             EM012310
         BNE   SCN004                                                   EM012320
         CLC   SMASK2+1(89),SMASK2                                      EM012330
         BNE   SCN004                                                   EM012340
         OI    SCNSWT4+1,X'F0'     DONT DO 2ND CMP - MASK ALL FF        EM012350
SCN004   CLI   SMASK3,X'FF'                                             EM012360
         BNE   SCN008A                                                  EM012370
         CLC   SMASK3+1(89),SMASK3                                      EM012380
         BNE   SCN008A                                                  EM012390
         OI    SCNSWT5+1,X'F0'     DONT DO 3RD CMP - MASK ALL FF        EM012400
         B     SCN008A                                                  EM012410
*                                                                       EM012420
SCNSWT1  NOP   SCN002              BRANCH IF SPLIT KEY OR LNG OVER 256  EM012430
         STH   3,SCNCMP+2          DISPLACEMENT INTO BOTH               EM012440
         STH   3,SCNCMP+4            OPERANDS OF CMP INSTR              EM012450
         OI    SCNCMP+2,X'10'      BASE REGISTER INTO BOTH              EM012460
         OI    SCNCMP+4,X'20'        OPERANDS OF CMP INSTR              EM012470
         SR    3,3                 INIT LNG CODE TO ZERO                EM012480
SCN005   LA    1,1(,1)             STEP DATA ADDR                       EM012490
         LA    2,1(,2)             STEP MASK ADDR                       EM012500
         CR    1,0                 CMP DATA ADDR TO LIMIT               EM012510
         BNL   SCN007              END OF DATA FIELD                    EM012520
         CLI   0(1),X'FF'                                               EM012530
         BE    SCN006              END OF KEY                           EM012540
         LA    3,1(,3)             STEP LNG CODE                        EM012550
         C     3,=F'256'                                                EM012560
         BL    SCN005              WITHIN LIMIT OF ONE CMP              EM012570
         OI    SCNSWT1+1,X'F0'     SET SWT FOR LNG OVER 256             EM012580
         B     SCN002              GO FINISH SETTING UP MASK            EM012590
*                                                                       EM012600
SCN006   MVI   0(2),X'FF'          SET MASK BYTE                        EM012610
         LA    1,1(,1)             STEP DATA ADDR                       EM012620
         LA    2,1(,2)             STEP MASK ADDR                       EM012630
         CR    1,0                 CMP DATA ADDR TO LIMIT               EM012640
         BNL   SCN007              END OF DATA FIELD                    EM012650
         CLI   0(1),X'FF'                                               EM012660
         BE    SCN006              NOT SPLIT KEY                        EM012670
         OI    SCNSWT1+1,X'F0'     SET SWT FOR SPLIT KEY                EM012680
         B     SCN002                                                   EM012690
*                                                                       EM012700
SCN007   NI    SCNSWT2+1,X'0F'     SET SWT FOR ONE CMP W/O MOVE         EM012710
         STC   3,SCNCMP+1          LNG CODE TO CMP INSTR                EM012720
         B     SCN008A                                                  EM012730
*                                                                       EM012740
SCN008   OI    BCBSWT1,X'40'       RESET SCAN SWT IF MORE THAN 1 BUFR   EM012750
SCN008A  BAL   14,GETBUFR          GET A BUFFER                         EM012760
SCN009   L     1,BCBRECAD          REC ADDR INTO R1                     EM012770
         L     2,XIODATA           DATA FIELD ADDR INTO R2              EM012780
SCNSWT2  NOP   SCN011              BRANCH IF SPLIT KEY OR LNG OVER 256  EM012790
SCNCMP   CLC   0(1,1),0(2)         CMP REC TO DATA FIELD                EM012800
SCN010   BE    SCN013                                                   EM012810
SCNBR    NOP   SCN012              MODIFIED TO BRANCH HIGH, LOW OR NOP  EM012820
         BAL   14,DECCNT           DECRAMENT SECTOR COUNT               EM012830
         BZ    SCN014              LAST SECTOR                          EM012840
         NI    BCBSWT1,X'BF'       SET SCAN SWT IF MORE THAN 1 SECTOR   EM012850
         BAL   14,STEPTR           STEP TRK AND REC                     EM012860
         CLI   XIOUCREC,X'05'      GO GET A BUFFER                      EM012870
         BE    SCN008                IF RECORD NUMBER                   EM012880
         CLI   XIOUCREC,X'00'          IS 5 OR ZERO -                   EM012890
         BE    SCN008                    STAR OF NEW BLOCK              EM012900
         L     2,BCBRECAD          STEP RECORD                          EM012910
         LA    2,270(,2)             ADDR WITHIN                        EM012920
         ST    2,BCBRECAD              SAME BLOCK                       EM012930
         B     SCN009              GO SCAN NEXT SECTOR                  EM012940
*                                                                       EM012950
SCN011   MVC   SWORKX,SCNBR+1      SET COND CODE TO NOT                 EM012960
         NI    SWORKX,X'0F'          SATISFY SCAN IN                    EM012970
         CLI   SWORKX,X'30'            CASE MASK ALL FF                 EM012980
SCNSWT3  NOP   SCNSWT4             BRANCH IF MASK 1 IS ALL FF           EM012990
         MVC   SWORK,0(1)          1ST 90 BYTES OF REC TO WORK AREA     EM013000
         OC    SWORK,SMASK1        FORCE FF BYTES TO CMP EQUAL          EM013010
         CLC   SWORK,0(2)          CMP WORK AREA TO DATA FIELD          EM013020
         BNE   SCNBR               GO TEST FOR HIGH OR LOW              EM013030
SCNSWT4  NOP   SCNSWT5             BRANCH IF MASK 2 IS ALL FF           EM013040
         MVC   SWORK,90(1)         2ND 90 BYTES OF REC TO WORK AREA     EM013050
         OC    SWORK,SMASK2        FORCE FF BYTES TO CMP EQUAL          EM013060
         CLC   SWORK,90(2)         CMP WORK AREA TO DATA FIELD          EM013070
         BNE   SCNBR               GO TEST FOR HIGH OR LOW              EM013080
SCNSWT5  NOP   SCN010              BRANCH IF MASK 3 IS ALL FF           EM013090
         MVC   SWORK,180(1)        3RD 90 BYTES OF REC TO WORK AREA     EM013100
         OC    SWORK,SMASK3        FORCE FF BYTES TO CMP EQUAL          EM013110
         CLC   SWORK,180(2)        CMP WORK AREA TO DATA FIELD          EM013120
         B     SCN010              GO TEST FOR EQUAL, HIGH OR LOW       EM013130
*                                                                       EM013140
SCN012   OI    XIOUSTAT,X'80'      SET UNEQUAL SCAN BIT IN UNIT STATUS  EM013150
SCN013   OI    XIOUSTAT,X'40'      SET SCAN HIT BIT IN UNIT STATUS      EM013160
SCN014   L     1,XIOCOUNT          UPDATE COUNT FIELD                   EM013170
         MVC   4(2,1),XIOUCTR        IN 360/20 PGM                      EM013180
         MVC   2(1,1),XIOICCYL                                          EM013190
         B     IOD006              GO TO COMMON END COMMAND RTN         EM013200
*                                                                       EM013210
SWORKX   DC    C' '                                                     EM013220
*                                                                       EM013230
         DROP  11                                                       EM013240
*                                                                       EM013250
         EJECT                                                          EM013260
*                                                                       EM013270
*                                                                       EM013280
*  ODD BALL ROUTINES  -  SENSE                  -  SENSE                EM013290
*                        READ COUNT             -  RDCOUNT              EM013300
*                        READ COUNT AND DATA    -  RDCTDTA              EM013310
*                        WRITE COUNT AND DATA   -  WRCTDTA              EM013320
*                        VERIFY COUNT AND DATA  -  VERCTDTA             EM013330
*                        RECALIBRATE            -  RECAL                EM013340
*                                                                       EM013350
*                                                                       EM013360
SENSE    L     4,=A(SENSEX)                                             EM013370
         B     LOADODD                                                  EM013380
*                                                                       EM013390
RDCOUNT  L     4,=A(RDCOUNTX)                                           EM013400
         B     LOADODD                                                  EM013410
*                                                                       EM013420
RDCTDTA  L     4,=A(RDCTDTAX)                                           EM013430
         B     LOADODD                                                  EM013440
*                                                                       EM013450
WRCTDTA  L     4,=A(WRCTDTAX)                                           EM013460
         B     LOADODD                                                  EM013470
*                                                                       EM013480
VERCTDTA L     4,=A(VERCTDTX)                                           EM013490
         B     LOADODD                                                  EM013500
*                                                                       EM013510
RECAL    L     4,=A(RECALX)                                             EM013520
LOADODD  L     11,=A(ODDBALL)                                           EM013530
         CLI   1(11),X'01'                                              EM013540
         BCR   8,4                 PHASE IS LOADED - GO TO RTN          EM013550
         MVI   PHASEXPH,C'1'       PHASE NUMBER TO NAME                 EM013560
         LA    1,PHASEX                                                 EM013570
******** LOAD  START                                                    EM013580
         LOAD  (1)                                                      EM013590
******** LOAD  END                                                      EM013600
         BR    4                   GO TO RTN IN PHASE JUST LOADED       EM013610
*                                                                       EM013620
         EJECT                                                          EM013630
*                                                                       EM013640
*                                                                       EM013650
*  SUBROUTINE TO VALIDATE AND SAVE SECTOR COUNT                         EM013660
*                                                                       EM013670
VALSECT  MVC   VSWORK,CCWSECTR     SECTOR COUNT TO WORK AREA            EM013680
         NI    VSWORK,X'7F'        ENSURE CHAIN BIT OFF                 EM013690
         CLI   VSWORK,X'00'                                             EM013700
         BE    VS003               ERROR IF SECTOR COUNT ZERO           EM013710
VS001    CLI   VSWORK,X'64'        X'0A' IF COUNT AREA COMMAND          EM013720
VS002    BH    VS003               BNE IF WRITE COUNT AND DATA          EM013730
         MVC   XIOSECTR,VSWORK     SAVE GOOD SECTOR COUNT               EM013740
         MVI   VS001+1,X'64'       RESET LIMIT TO 100                   EM013750
         NI    VS002+1,X'2F'       RESET BNE TO BH                      EM013760
         BR    14                  EXIT                                 EM013770
*                                                                       EM013780
VS003    MVI   VS001+1,X'64'                                            EM013790
         NI    VS002+1,X'2F'                                            EM013800
         B     DISKERR             INVALID COUNT                        EM013810
*                                                                       EM013820
VSWORK   DC    C' '                                                     EM013830
*                                                                       EM013840
         EJECT                                                          EM013850
*                                                                       EM013860
*                                                                       EM013870
*  SUBROUTINE TO VALIDATE AND SAVE COUNT FIELD AND DATA FIELD ADDRS     EM013880
*    ENTER AT VALDA TO SKIP COUNT FIELD                                 EM013890
*                                                                       EM013900
VALCFADA MVC   VAWORK,CCWCOUNT     ALIGN COUNT FIELD ADDR               EM013910
         LH    1,VAWORK                                                 EM013920
         C     1,=F'144'                                                EM013930
         BL    DISKERR                                                  EM013940
         CR    1,6                                                      EM013950
         BNL   DISKERR                                                  EM013960
         ST    1,XIOCOUNT          SAVE GOOD COUNT FIELD ADDR           EM013970
VALDA    MVC   VAWORK,CCWDATA      ALIGN DATA FIELD ADDR                EM013980
         LH    1,VAWORK                                                 EM013990
         C     1,=F'144'                                                EM014000
         BL    DISKERR                                                  EM014010
         CR    1,6                                                      EM014020
         BNL   DISKERR                                                  EM014030
         ST    1,XIODATA           SAVE GOOD DATA FIELD ADDR            EM014040
         BR    14                  EXIT                                 EM014050
*                                                                       EM014060
VAWORK   DC    H'0'                                                     EM014070
*                                                                       EM014080
         EJECT                                                          EM014090
*                                                                       EM014100
*                                                                       EM014110
*  SUBROUTINE TO VALIDATE AND SAVE TRK AND REC FROM COUNT FIELD         EM014120
*                                                                       EM014130
SETHDREC L     1,XIOCOUNT                                               EM014140
         CLI   4(1),X'09'          ERROR IF                             EM014150
         BH    DISKERR               TRK OR REC                         EM014160
         CLI   5(1),X'09'              GREATER                          EM014170
         BH    DISKERR                   THAN 9                         EM014180
         CLI   2(1),X'CA'                                               EM014190
         BH    DISKERR                                                  EM014200
         MVC   XIOICCYL,2(1)                                            EM014210
         MVC   XIOICTR,4(1)        SAVE GOOD                            EM014220
         MVC   XIOUCTR,4(1)          TRK AND REC                        EM014230
         BR    14                  EXIT                                 EM014240
*                                                                       EM014250
         EJECT                                                          EM014260
*                                                                       EM014270
*                                                                       EM014280
*  SUBROUTINE TO MOVE ONE SECTOR FROM OR TO 360/20 PGM                  EM014290
*                                                                       EM014300
MOVEFR20 L     1,XIODATA           360/20 DATA ADDR IS MOVE FR ADDR     EM014310
         LA    2,269(,1)                                                EM014320
         CR    2,6                                                      EM014330
         BNL   DISKERR                                                  EM014340
         L     2,BCBRECAD          BUFFER REC ADDR IS MOVE TO ADDR      EM014350
         OI    BCBSWT2,X'80'       SET WRITE BUFFER BIT ON              EM014360
         B     MOVE                GO TO COMMON MOVE                    EM014370
*                                                                       EM014380
MOVETO20 L     2,XIODATA           360/20 DATA ADDR IS MOVE TO ADDR     EM014390
         LA    1,269(,2)                                                EM014400
         CR    1,6                                                      EM014410
         BNL   DISKERR                                                  EM014420
         L     1,BCBRECAD          BUFFER REC ADDR IS MOVE FR ADDR      EM014430
MOVE     MVC   0(200,2),0(1)       MOVE ONE                             EM014440
         MVC   200(70,2),200(1)      SECTOR                             EM014450
         BR    14                  EXIT                                 EM014460
*                                                                       EM014470
         EJECT                                                          EM014480
*                                                                       EM014490
*                                                                       EM014500
*  SUBROUTINE TO DECRAMENT SECTOR COUNT BY ONE                          EM014510
*                                                                       EM014520
DECCNT   SR    1,1                 CLEAR R1                             EM014530
         IC    1,XIOSECTR                                               EM014540
         BCTR  1,0                 DECRAMENT BY ONE                     EM014550
         STC   1,XIOSECTR                                               EM014560
         LTR   1,1                 SET CONDITION CODE                   EM014570
         BR    14                  EXIT                                 EM014580
*                                                                       EM014590
         EJECT                                                          EM014600
*                                                                       EM014610
*                                                                       EM014620
*  SUBROUTINE TO STEP TRACK AND RECORD                                  EM014630
*                                                                       EM014640
STEPTR   SR    1,1                 CLEAR R1                             EM014650
         IC    1,XIOUCREC          STEP                                 EM014660
         LA    1,1(,1)               RECORD                             EM014670
         STC   1,XIOUCREC              NUMBER                           EM014680
         CLI   XIOUCREC,X'0A'                                           EM014690
         BCR   7,14                EXIT IF NOT 10                       EM014700
         MVI   XIOUCREC,X'00'      SET REC NUMBER TO ZERO               EM014710
         IC    1,XIOUCTRK          STEP                                 EM014720
         LA    1,1(,1)               TRACK                              EM014730
         STC   1,XIOUCTRK              NUMBER                           EM014740
         CLI   XIOUCTRK,X'0A'                                           EM014750
         BCR   7,14                EXIT IF NOT 10                       EM014760
         MVI   XIOUCTRK,X'00'      SET TRK NUMBER TO ZERO               EM014770
         IC    1,XIOICCYL          STEP                                 EM014780
         LA    1,1(,1)               CYLINDER                           EM014790
         STC   1,XIOICCYL              NUMBER                           EM014800
         CLI   XIOICCYL,X'CB'                                           EM014810
         BCR   7,14                EXIT IF NOT END OF PACK              EM014820
         B     DISKERR             INVALID CYL/TRK                      EM014830
*                                                                       EM014840
         EJECT                                                          EM014850
*                                                                       EM014860
*                                                                       EM014870
*  SUBROUTINE TO STEP DATA FIELD AND COUNT FIELD ADDRS                  EM014880
*                                                                       EM014890
STEPDCA  LM    1,2,XIODATCT                                             EM014900
         LA    1,270(,1)           STEP DATA FIELD ADDR BY 270          EM014910
         LA    2,9(,2)             STEP COUNT FIELD ADDR BY 9           EM014920
         CR    1,6                 ERROR IF                             EM014930
         BNL   DISKERR               EITHER ADDR                        EM014940
         CR    2,6                      NOT BELOW                       EM014950
         BNL   DISKERR                   EMULATOR                       EM014960
         STM   1,2,XIODATCT                                             EM014970
         BR    14                  EXIT                                 EM014980
*                                                                       EM014990
         EJECT                                                          EM015000
*                                                                       EM015010
*                                                                       EM015020
*  SUBROUTINE TO GET A BUFFER                                           EM015030
*                                                                       EM015040
GETBUFR  ST    14,GBSAVE                                                EM015050
         SR    1,1                 CALCULATE                            EM015060
         LR    2,1                   SAT                                EM015070
         IC    1,XIOICCYL       RELATIVE                                EM015080
         IC    2,XIOUCTRK       BLOCK                                   EM015090
         LA    1,1(,1)          NUMBER                                  EM015100
         LA    2,1(,2)          EQUAL                                   EM015110
         LR    3,1                  (CYL + 1)                           EM015120
         SLL   3,4                    TIMES 20                          EM015130
         SLL   1,2                PLUS                                  EM015140
         AR    3,1                  (TRK + 1)                           EM015150
         AR    3,2                    TIMES 2                           EM015160
         AR    3,2                MINUS                                 EM015170
         S     3,=F'20'             20                                  EM015180
         CLI   XIOUCREC,X'04'      SUBTRACT 1                           EM015190
         BH    GB002                 IF SECTOR                          EM015200
         BCTR  3,0                   0 THRU 4                           EM015210
GB002    STH   3,GBWORK4           PUT REL BLK                          EM015220
         MVC   XIOSRB,GBWORK4        INTO XIO TBL                       EM015230
         XC    GBWORK,GBWORK       INITIALIZE                           EM015240
         MVC   GBWORK4,=X'FFFF'      SAVE AREAS                         EM015250
         L     4,=A(BUFFER01)      POINT R4 TO 1ST BUFFER CONTROL BLOCK EM015260
         DO    &CCC                                                     EM015270
         L     4,BCBNBA       ***** 8411 ONLY *****                     EM015280
         ENDO                                                           EM015290
GB003    LH    1,BCBUSE            USE COUNT INTO R1                    EM015300
         LTR   1,1                                                      EM015310
         BZ    GB004               DONT DECRAMENT IF ALREADY ZERO       EM015320
         BCTR  1,0                 DECRAMENT USE COUNT                  EM015330
         STH   1,BCBUSE                                                 EM015340
         CLI   BCBUSE+1,X'10'                                           EM015350
         BH    GB004                                                    EM015360
         OI    BCBSWT1,X'40'       RESET SCAN SWT                       EM015370
GB004    CLC   BCBUSRB,XIOUSRB     CHECK IF THIS BLOCK IN CORE          EM015380
         BNE   GB005               NO                                   EM015390
         ST    4,GBWORK1           YES - SAVE ADDR OF BCB               EM015400
         B     GB008                                                    EM015410
*                                                                       EM015420
GB005    CLI   BCBUNIT,X'00'       IS THIS BUFFER AVAILABLE             EM015430
         BNE   GB006               NO                                   EM015440
         ST    4,GBWORK2           YES - SAVE ADDR OF BCB               EM015450
         B     GB008                                                    EM015460
*                                                                       EM015470
GB006    CLC   BCBSWT1,GBWORK3     CMP TO PREVIOUS HIGH SWT 1           EM015480
         BH    GB007               USE THIS ONE                         EM015490
         BL    GB008               KEEP PRIOR ONE                       EM015500
         CLC   BCBUSE,GBWORK4      CMP TO PREVIOUS LOW USE CNT          EM015510
         BH    GB008               KEEP PRIOR ONE                       EM015520
GB007    ST    4,GBWORK3           SAVE ADDR OF BCB                     EM015530
         MVC   GBWORK3(1),BCBSWT1  SAVE SWT 1                           EM015540
         MVC   GBWORK4,BCBUSE      SAVE USE COUNT                       EM015550
GB008    L     4,BCBNBA            STEP TO NEXT BUFFER                  EM015560
         LTR   4,4                                                      EM015570
         BNZ   GB003               NOT LAST BUFFER                      EM015580
         MVI   GBWORK3,X'00'                                            EM015590
         LM    1,3,GBWORK                                               EM015600
         LTR   4,1                                                      EM015610
         BNZ   GB010               THIS BUFFER ALREADY IN CORE - USE IT EM015620
         LTR   4,2                                                      EM015630
         BNZ   GB009               GO READ INTO AVAILABLE BUFFER        EM015640
         LR    4,3                                                      EM015650
         NI    FB003+1,X'0F'                                            EM015660
         BAL   14,FREEBUFR                                              EM015670
GB009    L     10,XIOSAT                                                EM015680
         MVC   SATSRB,XIOSRB       REL BLK TO SAT                       EM015690
         LA    0,BCBBUFR           I/O AREA                             EM015700
         ST    0,GBWORK              ADDR                               EM015710
         MVC   SATIOA,GBWORK+1         TO SAT                           EM015720
         LA    0,SATPCA            PCA ADDR INTO R0                     EM015730
         LR    1,10                                                     EM015740
         DO    &CCC                                                     EM015750
         MVC   NOGETLIM,=H'2' ***** 8411 ONLY *****                     EM015760
         TM    XIOSWT,X'40'   ***** 8411 ONLY *****                     EM015770
         BZ    GB009B         ***** 8411 ONLY *****                     EM015780
         MVC   NOGETLIM,=H'801' *** 8411 ONLY *****                     EM015790
         CLC   SATSRB,=H'80'  ***** 8411 ONLY *****                     EM015800
         BH    GB009A         ***** 8411 ONLY *****                     EM015810
         STM   9,11,GBSV8411  ***** 8411 ONLY *****                     EM015820
         OI    X8411SWT+1,X'F0' *** 8411 ONLY *****                     EM015830
         BAL   14,X8411       ***** 8411 ONLY *****                     EM015840
         LM    9,11,GBSV8411  ***** 8411 ONLY *****                     EM015850
         B     GB009C         ***** 8411 ONLY *****                     EM015860
*                             ***** 8411 ONLY *****                     EM015870
GB009A   LH    15,SATSRB      ***** 8411 ONLY *****                     EM015880
         SH    15,=H'80'      ***** 8411 ONLY *****                     EM015890
         STH   15,SATSRB      ***** 8411 ONLY *****                     EM015900
GB009B   DS    0H             ***** 8411 ONLY *****                     EM015910
         ENDO                                                           EM015920
         CLI   XIOCC,X'01'         DONT GET                             EM015930
         BE    GB009X1               IF CC IS                           EM015940
         CLI   XIOCC,X'11'           WRITE DATA OR                      EM015950
         BNE   GB009X2               WRITE COUNT AND DATA               EM015960
GB009X1  CLI   XIOSECTR,X'05'        AND SECTOR COUNT                   EM015970
         BL    GB009X2               IS 5 OR MORE                       EM015980
         CLC   SATSRB,NOGETLIM       AND SAT REL BLK NOT                EM015990
         BL    GB009X2               LESS THAN 2 (801 IF 8411)          EM016000
         CLI   XIOUCREC,X'00'        AND SECTOR                         EM016010
         BE    GB009X3               NUMBER IS                          EM016020
         CLI   XIOUCREC,X'05'        ZERO OR                            EM016030
         BE    GB009X3               FIVE                               EM016040
GB009X2  DS    0H                                                       EM016050
******** GET?  START                                                    EM016060
         GET?  (1),(0)                                                  EM016070
******** GET?  END                                                      EM016080
         OI    GB013+1,X'F0'       SET WAIT SWT                         EM016090
GB009X3  DS    0H                                                       EM016100
         DO    &CCC                                                     EM016110
GB009C   DS    0H             ***** 8411 ONLY *****                     EM016120
         ENDO                                                           EM016130
         MVC   BCBUSRB,XIOUSRB     UNIT AND SAT REL BLK TO BCB          EM016140
         MVI   BCBSWT1,X'40'       INIT BCB SWT 1                       EM016150
         MVC   BCBSAT,XIOSAT       SAT ADDR TO BCB                      EM016160
         DO    &CCC                                                     EM016170
         MVC   BCBSWT3,XIOSWT ***** 8411 ONLY *****                     EM016180
         ENDO                                                           EM016190
GB010    MVI   BCBUSE+1,X'FF'      INIT BCB USE SWT                     EM016200
         SR    3,3                 CALCULATE                            EM016210
         IC    3,XIOUCREC            AND                                EM016220
         CLI   XIOUCREC,X'05'        SAVE                               EM016230
         BL    GB011                 ADDR                               EM016240
         S     3,=F'5'               OF                                 EM016250
GB011    LA    3,1(,3)               THIS                               EM016260
         LA    2,BCBBUFR             REC                                EM016270
GB012    BCT   3,GB016               WITHIN                             EM016280
         ST    2,BCBRECAD            BLOCK                              EM016290
         C     4,=A(BUFFER01)                                           EM016300
         BNE   GB013                                                    EM016310
         MVI   PHASE,C' '                                               EM016320
GB013    NOP   GB015               BRANCH TO WAIT IF GET WAS ISSUED     EM016330
GB014    L     14,GBSAVE                                                EM016340
         BR    14                  EXIT                                 EM016350
*                                                                       EM016360
GB015    NI    GB013+1,X'0F'       RESET WAIT SWT                       EM016370
         LR    1,10                                                     EM016380
         TM    E2$RAMOD,X'04'                                           EM016390
         BZ    *+12                                                     EM016400
         TM    2(1),X'80'                                               EM016410
         BZ    *-4                                                      EM016420
******** WAITF? START                                                   EM016430
         WAITF? (1)                                                     EM016440
******** WAITF? END                                                     EM016450
         B     GB014               GO TO EXIT                           EM016460
*                                                                       EM016470
GB016    LA    2,270(,2)                                                EM016480
         B     GB012                                                    EM016490
*                                                                       EM016500
GBSAVE   DC    F'0'                                                     EM016510
         DO    &CCC                                                     EM016520
GBSV8411 DC    3F'0'          ***** 8411 ONLY *****                     EM016530
         ENDO                                                           EM016540
*                                                                       EM016550
         DS    0F                                                       EM016560
GBWORK   DS    0CL12                                                    EM016570
GBWORK1  DC    F'0'                                                     EM016580
GBWORK2  DC    F'0'                                                     EM016590
GBWORK3  DC    F'0'                                                     EM016600
*                                                                       EM016610
GBWORK4  DC    H'0'                                                     EM016620
*                                                                       EM016630
NOGETLIM DC    H'2'                801 IF 8411                          EM016640
         EJECT                                                          EM016650
*                                                                       EM016660
*                                                                       EM016670
*  SUBROUTINE TO FREE BUFFER                                            EM016680
*                                                                       EM016690
FREEBUFR CLI   BCBUNIT,X'00'                                            EM016700
         BCR   8,14                EXIT - BUFFER NOT IN USE             EM016710
         MVI   BCBUNIT,X'00'       MARK BUFFER AVAILABLE                EM016720
         TM    BCBSWT2,X'80'                                            EM016730
         BCR   8,14                EXIT - NO WRITES                     EM016740
         STM   9,14,FBSAVE                                              EM016750
         L     10,BCBSAT                                                EM016760
         MVC   SATSRB,BCBSRB                                            EM016770
         LA    0,BCBBUFR                                                EM016780
         ST    0,FBWORK                                                 EM016790
         MVC   SATIOA,FBWORK+1                                          EM016800
         LA    0,SATPCA                                                 EM016810
         LR    1,10                                                     EM016820
         DO    &CCC                                                     EM016830
         TM    BCBSWT3,X'40'  ***** 8411 ONLY *****                     EM016840
         BZ    FB002          ***** 8411 ONLY *****                     EM016850
         CLC   SATSRB,=H'80'  ***** 8411 ONLY *****                     EM016860
         BH    FB001          ***** 8411 ONLY *****                     EM016870
         NI    X8411SWT+1,X'0F' *** 8411 ONLY *****                     EM016880
         BAL   14,X8411       ***** 8411 ONLY *****                     EM016890
         B     FB004          ***** 8411 ONLY *****                     EM016900
*                             ***** 8411 ONLY *****                     EM016910
FB001    LH    15,SATSRB      ***** 8411 ONLY *****                     EM016920
         SH    15,=H'80'      ***** 8411 ONLY *****                     EM016930
         STH   15,SATSRB      ***** 8411 ONLY *****                     EM016940
FB002    DS    0H             ***** 8411 ONLY *****                     EM016950
         ENDO                                                           EM016960
         BAL   14,PUTSUB                                                EM016970
         TM    SATWAIT,X'80'                                            EM016980
FB003    BZ    *-4                 NOP IF ENTERED FROM DISK TASK        EM016990
         LR    1,10                                                     EM017000
         TM    E2$RAMOD,X'04'                                           EM017010
         BZ    *+12                                                     EM017020
         TM    2(1),X'80'                                               EM017030
         BZ    *-4                                                      EM017040
******** WAITF? START                                                   EM017050
         WAITF? (1)                                                     EM017060
******** WAITF? END                                                     EM017070
         DO    &CCC                                                     EM017080
FB004    DS    0H             ***** 8411 ONLY *****                     EM017090
         ENDO                                                           EM017100
         LM    9,14,FBSAVE                                              EM017110
         BR    14                                                       EM017120
*                                                                       EM017130
FBWORK   DC    F'0'                                                     EM017140
FBSAVE   DC    6F'0'                                                    EM017150
*                                                                       EM017160
         DO    &CCC                                                     EM017170
         EJECT                                                          EM017180
*                                                                       EM017190
*                                                                       EM017200
*  SUBROUTINE FOR 8411 I/O CYL 0-3                                      EM017210
*                                                                       EM017220
X8411    ST    14,X8411SV                                               EM017230
         MVC   X8411WK+1(3),SATIOA      PUT MOVE                        EM017240
         L     11,X8411WK                 ADDRS INTO                    EM017250
         L     12,=A(BUFFERXX+1401)       R11 AND R12                   EM017260
         MVC   SATIOA,=AL3(BUFFERXX)    CHG SAT I/O AREA ADDR           EM017270
         LA    9,10                     INIT LOOP CONTROL COUNTER       EM017280
         LH    15,SATSRB                CALCULATE 1ST                   EM017290
         LA    1,0(15,15)                 REL BLK EQUAL                 EM017300
         SLL   15,3                       THIS REL BLK                  EM017310
         AR    15,1                       TIMES 10                      EM017320
         SH    15,=H'9'                   MINUS 9                       EM017330
X8411X1  STH   15,SATSRB                REL BLK INTO PCA                EM017340
         LA    0,SATPCA                                                 EM017350
         LR    1,10                                                     EM017360
******** GET?  START                                                    EM017370
         GET?  (1),(0)                                                  EM017380
******** GET?  END                                                      EM017390
         LR    1,10                                                     EM017400
         TM    2(1),X'80'                                               EM017410
         BZ    *-4                                                      EM017420
******** WAITF? START                                                   EM017430
         WAITF? (1)                                                     EM017440
******** WAITF? END                                                     EM017450
X8411SWT NOP   X8411X2                  BRANCH IF GET                   EM017460
         MVC   0(135,12),0(11)          MOVE FROM NORMAL BUFFER         EM017470
         LA    0,SATPCA                                                 EM017480
         LR    1,10                                                     EM017490
         BAL   14,PUTSUB                                                EM017500
         LR    1,10                                                     EM017510
         TM    2(1),X'80'                                               EM017520
         BZ    *-4                                                      EM017530
******** WAITF? START                                                   EM017540
         WAITF? (1)                                                     EM017550
******** WAITF? END                                                     EM017560
         B     X8411X3                                                  EM017570
*                                                                       EM017580
X8411X2  MVC   0(135,11),0(12)          MOVE TO NORMAL BUFFER           EM017590
X8411X3  LA    11,135(,11)              STEP ADDR WITHIN NORMAL BUFFER  EM017600
         LH    15,SATSRB                STEP                            EM017610
         LA    15,1(,15)                  REL BLK                       EM017620
         BCT   9,X8411X1                BRANCH FOR NEXT 135 BYTES       EM017630
         MVI   PHASE,C' '          ENSURE LOAD AFTER USING OVERLAY AREA EM017640
         L     14,X8411SV                                               EM017650
         BR    14                       EXIT                            EM017660
*                                                                       EM017670
X8411WK  DC    F'0'                                                     EM017680
X8411SV  DC    F'0'                                                     EM017690
*                                                                       EM017700
         ENDO                                                           EM017710
         ENDO                                                           EM017720
         TITLE '360/20 DISC/TAPE EMULATOR - ROOT LITERALS - &NNN'       EM017730
         LTORAR                                                         EM017740
         DO    &D>0                                                     EM017750
         TITLE '360/20 DISC/TAPE EMULATOR - DISC PUT - &NNN'            EM017760
*                                                                       EM017770
*                                                                       EM017780
PUTSUB   STM   14,2,PUTREGS                                             EM017790
         BALR  2,0                                                      EM017800
         USING *,2                                                      EM017810
         TM    SATSWT,X'10'                                             EM017820
         BZ    PUTPUT              NO VERIFY - DONT HAVE TO BE IN TASK  EM017830
         TM    FB003+1,X'80'                                            EM017840
         BZ    PUTPUT              ALREADY IN TASK                      EM017850
         NI    PUTSWT+1,X'0F'      SET SWT IN TASK TO PUT AND YIELD     EM017860
******** AWAKE START                                                    EM017870
         AWAKE DISKECB                                                  EM017880
******** AWAKE END                                                      EM017890
         TM    DISKECB+2,X'80'     WAIT FOR                             EM017900
         BZ    *-4                   TASK                               EM017910
         LM    14,2,PUTREGS                                             EM017920
         BR    14                  EXIT                                 EM017930
*                                                                       EM017940
******** PUT?  START                                                    EM017950
PUTPUT   PUT?  (1),(0)                                                  EM017960
******** PUT?  END                                                      EM017970
         LM    14,2,PUTREGS                                             EM017980
         BR    14                  EXIT                                 EM017990
*                                                                       EM018000
*                                                                       EM018010
         LTORAR                                                         EM018020
*                                                                       EM018030
*                                                                       EM018040
         DROP  2                                                        EM018050
*                                                                       EM018060
*                                                                       EM018070
         ENDO                                                           EM018080
         TITLE '360/20 DISC/TAPE EMULATOR - IN-LINE PATCH AREA - &NNN'  EM018090
         PTCHAR 10                                                      EM018100
         TITLE '360/20 DISC/TAPE EMULATOR - CSECT 21 - &NNN'            EM018110
*                                                                       EM018120
*                        ODD BALL ROUTINES                              EM018130
*                                                                       EM018140
*                                                                       EM018150
*                                                                       EM018160
&W       SET   '&NNN'.'21'                                              EM018170
&W       CSCTAR                                                         EM018180
*                                                                       EM018190
*                                                                       EM018200
         DO    &D>0                                                     EM018210
*  THIS CSECT CONTAINS THE ROUTINES FOR EMULATING THE LESS FREQUENTLY   EM018220
*    USED 360-20 DISK COMMANDS  -  SENSE                                EM018230
*                                  READ COUNT                           EM018240
*                                  READ COUNT AND DATA                  EM018250
*                                  WRITE COUNT AND DATA                 EM018260
*                                  VERIFY COUNT AND DATA                EM018270
*                                  RECALIBRATE                          EM018280
*                                                                       EM018290
*  IT MAY ALSO BE USED AS A WORK AREA FOR SCAN COMMANDS OR AS THE       EM018300
*    OVERLAY AREA FOR THE EMULATOR CLOSE ROUTINE.                       EM018310
*                                                                       EM018320
*  THE SECOND BYTE WILL IDENTIFY THE CURRENT USE OF THE AREA IN ORDER   EM018330
*    TO AVOID LOADING A PHASE WHICH IS ALREADY IN CORE -                EM018340
*                                                                       EM018350
*              HEX '01'  -  360-20 ODD BALL RTNS                        EM018360
*              HEX '08'  -  EMULATOR CLOSE RTN                          EM018370
*                                                                       EM018380
*    THE SECOND BYTE CAN ONLY BE HEX '00' OR HEX 'FF' IF THE AREA IS    EM018390
*    BEING USED AS A WORK AREA FOR 360-20 SCAN COMMANDS.                EM018400
*                                                                       EM018410
*                                                                       EM018420
         USING ODDBALL,11                                               EM018430
*                                                                       EM018440
*                                                                       EM018450
         ENDO                                                           EM018460
ODDBALL  DC    H'1'                PHASE IDENT                          EM018470
*                                                                       EM018480
         DO    &D=0                                                     EM018490
         DC    7H'0'     PHASE NOT USED IF NO DISK - SPACE REQ FOR LINK EM018500
         ENDO                                                           EM018510
         DO    &D>0                                                     EM018520
*                                                                       EM018530
*  SENSE                                                                EM018540
*                                                                       EM018550
SENSEX   L     2,XIODATA                                                EM018560
         STH   2,SNSWORK           SAVE LAST DATA FIELD ADDR            EM018570
         BAL   14,VALDA            VALIDATE AND SAVE THIS DATA FLD ADR  EM018580
         LA    0,4(,1)                                                  EM018590
         CR    0,6                                                      EM018600
         BNL   DISKERR             ADDR ABOVE 360/20 PGM                EM018610
         MVI   XIOUSTAT,X'00'      INIT UNIT STATUS                     EM018620
         MVC   0(1,1),XIOSSTAT     SENSE STATUS TO STATUS FIELD         EM018630
         MVC   1(2,1),SNSWORK      LAST DATA FIELD ADDR TO DATA FIELD   EM018640
         CLI   XIOCC,X'02'                                              EM018650
         BE    SNS001               LAST CC WAS READ DATA               EM018660
         CLI   XIOCC,X'01'                                              EM018670
         BE    SNS001               LAST CC WAS WRITE DATA              EM018680
         CLI   XIOCC,X'41'                                              EM018690
         BE    SNS001               LAST CC WAS VERIFY DATA             EM018700
         CLI   XIOCC,X'51'                                              EM018710
         BE    SNS002               LAST CC WAS SCAN LOW OR EQUAL       EM018720
         CLI   XIOCC,X'61'                                              EM018730
         BE    SNS002               LAST CC WAS SCAN EQUAL              EM018740
         CLI   XIOCC,X'71'                                              EM018750
         BE    SNS002               LAST CC WAS SCAN HIGH OR EQUAL      EM018760
         L     3,XIOCOUNT                                               EM018770
         STH   3,SNSWORK                                                EM018780
         MVC   3(2,1),SNSWORK      LAST COUNT FIELD ADDR TO COUNT FIELD EM018790
         B     SNS003                                                   EM018800
*                                                                       EM018810
SNS001   MVC   3(2,1),XIOUCTR      UPDATE TRK AND REC TO COUNT FIELD    EM018820
         B     SNS003                                                   EM018830
*                                                                       EM018840
SNS002   MVC   3(2,1),XIOICTR     INITIAL TRK AND REC TO COUNT FIELD    EM018850
SNS003   ST    2,XIODATA           RESTORE LAST DATA FIELD ADDR         EM018860
         B     IOD006              GO TO COMMON END COMMAND RTN         EM018870
*                                                                       EM018880
SNSWORK  DC    H'0'                                                     EM018890
*                                                                       EM018900
*                                                                       EM018910
*  READ COUNT                                                           EM018920
*                                                                       EM018930
RDCOUNTX OI    WC000B+1,X'F0'                                           EM018940
         B     WC000A                                                   EM018950
*                                                                       EM018960
*                                                                       EM018970
*  READ COUNT AND DATA                                                  EM018980
*                                                                       EM018990
RDCTDTAX OI    WC002+1,X'F0'                                            EM019000
         B     WC000                                                    EM019010
*                                                                       EM019020
*                                                                       EM019030
*  WRITE OR VERIFY COUNT AND DATA                                       EM019040
*                                                                       EM019050
WRCTDTAX OI    VS002+1,X'70'                                            EM019060
VERCTDTX NI    WC002+1,X'0F'                                            EM019070
WC000    NI    WC000B+1,X'0F'                                           EM019080
WC000A   MVI   VS001+1,X'0A'                                            EM019090
         BAL   14,VALSECT          VALIDATE AND SAVE SECTOR COUNT       EM019100
         BAL   14,VALCFADA         VALIDATE AND SAVE CNT AND DATA ADDRS EM019110
         MVI   XIOICREC,X'00'      FORCE RECORD                         EM019120
         MVI   XIOUCREC,X'00'        NUMBER TO ZERO                     EM019130
         MVC   XIOCC,CCWCC         SAVE COMMAND CODE                    EM019140
         XC    XIOSTATS,XIOSTATS   INIT STATUS BYTES                    EM019150
WC000B   NOP   WC005               BRANCH IF READ COUNT                 EM019160
WC001    BAL   14,GETBUFR          GET BUFFER                           EM019170
WC002    NOP   WC004               BRANCH IF READ COUNT AND DATA        EM019180
         L     2,XIOCOUNT                                               EM019190
         LA    0,8(,2)                                                  EM019200
         CR    0,6                                                      EM019210
         BNL   DISKERR             ADDR ABOVE 360/20 PGM                EM019220
         CLC   XIOICCYL,2(2)                                            EM019230
         BNE   DISKERR             INVALID CYL                          EM019240
         CLC   XIOUCTR,4(2)                                             EM019250
         BNE   DISKERR             INVALID TRK/REC                      EM019260
         BAL   14,MOVEFR20         MOVE SECTOR FROM 360/20 PGM          EM019270
WC003    BAL   14,DECCNT           DECRAMENT SECTOR COUNT               EM019280
         BZ    IOD006              LAST SECTOR - GO TO COMMON END RTN   EM019290
         BAL   14,STEPTR           STEP TRK AND REC                     EM019300
         BAL   14,STEPDCA          STEP DATA AND CNT FIELD ADDRS        EM019310
         CLI   XIOUCREC,X'05'      GO GET BUFFER IF REC NUMBER          EM019320
         BE    WC001                 IS 5 - START OF NEW BLOCK          EM019330
         L     2,BCBRECAD          STEP RECORD                          EM019340
         LA    2,270(,2)             ADDR WITHIN                        EM019350
         ST    2,BCBRECAD              SAME BLOCK                       EM019360
         B     WC002               GO PROCESS NEXT RECORD               EM019370
*                                                                       EM019380
WC004    BAL   14,WC006            BUILD COUNT FIELD IN 360/20 PGM      EM019390
         BAL   14,MOVETO20         MOVE SECTOR TO 360/20 PGM            EM019400
         B     WC003                                                    EM019410
*                                                                       EM019420
WC005    BAL   14,WC006            BUILD COUNT FIELD IN 360/20 PGM      EM019430
         B     IOD006              GO TO COMMON END COMMAND RTN         EM019440
*                                                                       EM019450
*                                                                       EM019460
*  SUBROUTINE TO BUILD COUNT FIELD IN 360/20 PGM                        EM019470
*                                                                       EM019480
WC006    L     1,XIOCOUNT                                               EM019490
         LA    2,8(,1)                                                  EM019500
         CR    2,6                                                      EM019510
         BNL   DISKERR             ADDR ABOVE 360/20 PGM                EM019520
         XC    0(7,1),0(1)         INIT COUNT FIELD                     EM019530
         MVC   7(2,1),=H'270'      FORCE LNG 270                        EM019540
         MVC   2(1,1),XIOICCYL     CYL TO COUNT FIELD                   EM019550
         MVC   4(2,1),XIOUCTR      TRK AND REC TO COUNT FIELD           EM019560
         MVC   4(2,1),XIOUCTR      TRK AND REC TO COUNT FIELD           EM019570
         BR    14                  EXIT                                 EM019580
*                                                                       EM019590
*                                                                       EM019600
*  RECALIBRATE                                                          EM019610
*                                                                       EM019620
RECALX   MVI   XIOICCYL,X'00'      SET CYL                              EM019630
         MVI   XIOICTRK,X'00'        AND TRK                            EM019640
         MVI   XIOUCTRK,X'00'          TO ZERO                          EM019650
         B     SEEK001                                                  EM019660
*                                                                       EM019670
*                                                                       EM019680
         LTORAR                                                         EM019690
*                                                                       EM019700
*                                                                       EM019710
PTCH21   PTCHAR 4                                                       EM019720
         ORG   ODDBALL                                                  EM019730
*                                                                       EM019740
SMASK    DS    0CL270                                                   EM019750
SMASK1   DS    CL90                                                     EM019760
SMASK2   DS    CL90                                                     EM019770
SMASK3   DS    CL90                                                     EM019780
*                                                                       EM019790
SWORK    DS    CL90                                                     EM019800
*                                                                       EM019810
         ORG                                                            EM019820
         USING FCB,11                                                   EM019830
         ENDO                                                           EM019840
*                                                                       EM019850
*                                                                       EM019860
         TITLE '360/20 DISC/TAPE EMULATOR - CSECTS 22 AND 23 - &NNN'    EM019870
*                                                                       EM019880
*                        BUFFER CSECTS                                  EM019890
*                                                                       EM019900
*                                                                       EM019910
*                                                                       EM019920
&W       SET   '&NNN'.'22'                                              EM019930
&W       CSCTAR                                                         EM019940
*                                                                       EM019950
*                                                                       EM019960
         DO    &D=0                                                     EM019970
         DC    2F'0'     PHASE NOT USED IF NO DISK - GEN FOR LINK EDIT  EM019980
         ENDO                                                           EM019990
         DO    &D>0                                                     EM020000
*                                                                       EM020010
*  THIS CSECT IS THE FIRST 360 BYTES OF A 1556 BYTE DISK BUFFER AREA.   EM020020
*                                                                       EM020030
*  WHEN THE BUFFER IS FREE THE FIRST 336 BYTES FOLLOWING THE BUFFER     EM020040
*    CONTROL BLOCK MAY BE USED AS 256 BYTE FCB AND 80 BYTE GETCS AREAS. EM020050
*                                                                       EM020060
*                                                                       EM020070
BUFFER01 DC    XL20'00'  THE 1ST 20 BYTES ARE THE BUFFER CONTROL BLOCK  EM020080
BUFFERXX DC    XL40'00'       THE ACTUAL DISK I/O AREA STARTS HERE      EM020090
         DC    3XL100'00'       AND CONTINUES THRU THE NEXT CSECT.      EM020100
         ENDO                                                           EM020110
*                                                                       EM020120
*                                                                       EM020130
&W       SET   '&NNN'.'23'                                              EM020140
&W       CSCTAR                                                         EM020150
*                                                                       EM020160
*                                                                       EM020170
         DO    &D=0                                                     EM020180
OVAREA   DC    12XL100'00'    OVERLAY AREA FOR INFREQUENTLY USED RTNS   EM020190
         ENDO                                                           EM020200
         DO    &D>0                                                     EM020210
*                                                                       EM020220
*  THIS CSECT IS THE LAST 1196 BYTES OF A 1556 BYTE DISK BUFFER AREA.   EM020230
*                                                                       EM020240
*  IT IS ALSO USED AS THE OVERLAY AREA FOR INFREQUENTLY USED ROUTINES.  EM020250
*                                                                       EM020260
OVAREA   DC    12XL100'00'    1196 ROUNDED TO NEXT MULTIPLE OF 8        EM020270
*                                                                       EM020280
         ENDO                                                           EM020290
         TITLE '360/20 DISC/TAPE EMULATOR - CSECT 24 - &NNN'            EM020300
*                                                                       EM020310
*                        FIRST HSKP - OPEN                              EM020320
*                                                                       EM020330
*                                                                       EM020340
*                                                                       EM020350
*        THIS CSECT WILL OVERLAY OVAREA - CSECT 23                      EM020360
*                                                                       EM020370
*                                                                       EM020380
&W       SET   '&NNN'.'24'                                              EM020390
&W       CSCTAR                                                         EM020400
*                                                                       EM020410
*                                                                       EM020420
         USING EMHKSAVE,12                                              EM020430
*                                                                       EM020440
*                                                                       EM020450
EMHKSAVE DC    F'0'                                                     EM020460
*                                                                       EM020470
*                                                                       EM020480
EMHK     ST    11,EMHKSAVE                                              EM020490
         MVC   PHASEXNM,E2$RAPGM                                        EM020500
         DO    &D>0                                                     EM020510
         L     11,=A(BUFFER01)                                          EM020520
         XC    0(20,11),0(11)      INIT 1ST BUFR CONTROL BLOCK          EM020530
         ENDO                                                           EM020540
         L     11,=A(ODDBALL)                                           EM020550
         MVI   1(11),X'00'         INIT OVLAY ID AS NO PHASE LOADED     EM020560
         LA    11,4088(,8)         USE 20 AREA ABOVE MONITOR AS BUFR    EM020570
         DO    &D>0                                                     EM020580
         ST    11,EMHKBUFR                                              EM020590
         ENDO                                                           EM020600
         L     1,E2$RACSP                                               EM020610
******** SETCS START                                                    EM020620
         SETCS (1),R                                                    EM020630
******** SETCS END                                                      EM020640
EMHKX1   LA    1,GETCSIOA                                               EM020650
******** GETCS START                                                    EM020660
         GETCS (1)                                                      EM020670
******** GETCS END                                                      EM020680
         DO    &T>0                                                     EM020690
         CLI   GETCSID,C'4'                                             EM020700
         BE    EMHKX4              TAPE CARD                            EM020710
         ENDO                                                           EM020720
         DO    &D>0                                                     EM020730
         CLI   GETCSID,C'2'                                             EM020740
         BE    EMHKX1A             DISK CARD                            EM020750
         ENDO                                                           EM020760
         CLI   GETCSID,C'3'                                             EM020770
         BE    EMHKX1              IGNORE TYPE 3 CARDS                  EM020780
         B     EMHKX9              END TAPE AND DISK CARDS              EM020790
*                                                                       EM020800
         DO    &D>0                                                     EM020810
EMHKX1A  NI    DGCSDRV,X'0F'                                            EM020820
         L     1,=A(XIO1)                                               EM020830
EMHKX2   CLI   0(1),X'00'                                               EM020840
         BE    EMHKX1              END XIO TBL - GO GET NEXT CARD       EM020850
         CLC   DGCSDRV,0(1)                                             EM020860
         BE    EMHKX3              FOUND DRIVE IN TBL                   EM020870
         LA    1,28(,1)                                                 EM020880
         B     EMHKX2                                                   EM020890
*                                                                       EM020900
EMHKX3   OI    0(1),X'10'          MARK DRIVE USED                      EM020910
         B     EMHKX1              GO GET NEXT CARD                     EM020920
*                                                                       EM020930
         ENDO                                                           EM020940
         DO    &T>0                                                     EM020950
EMHKX4   NI    TGCSDRV,X'8F'                                            EM020960
         L     1,=A(TPADDRS)                                            EM020970
EMHKX5   CLI   0(1),X'00'                                               EM020980
         BE    EMHKX1              END TAPE TBL - GO GET NEXT CARD      EM020990
         CLC   TGCSDRV,0(1)                                             EM021000
         BE    EMHKX6              FOUND TAPE IN TBL                    EM021010
         LA    1,8(,1)                                                  EM021020
         B     EMHKX5                                                   EM021030
*                                                                       EM021040
EMHKX6   OI    0(1),X'10'          MARK TAPE USED                       EM021050
         CLI   TGCSMOD,C' '                                             EM021060
         BE    EMHKX1              9-TRK - GO GET NEXT CARD             EM021070
         CLI   TGCSMOD,C'C'                                             EM021080
         BE    EMHKX1              9-TRK - GO GET NEXT CARD             EM021090
         MVC   4(2,1),=X'00FF'     7-TRK MODE SET MASK TO TBL           EM021100
         B     EMHKX1              GO GET NEXT CARD                     EM021110
*                                                                       EM021120
         ENDO                                                           EM021130
EMHKX9   ST    1,E2$RACSR          GETCS POINTER INTO ADDR TBL          EM021140
         DO    &D>0                                                     EM021150
         L     1,=A(XIO1)                                               EM021160
         LA    2,28                                                     EM021170
         MVI   EMHKXX00+1,X'1B'                                         EM021180
         BAL   14,EMHKXX           COMPRESS DISK XIO TABLE              EM021190
         ENDO                                                           EM021200
         DO    &T>0                                                     EM021210
         L     1,=A(TPADDRS)                                            EM021220
         LA    2,8                                                      EM021230
         MVI   EMHKXX00+1,X'07'                                         EM021240
         BAL   14,EMHKXX           COMPRESS TAPE ADDR TABLE             EM021250
         ENDO                                                           EM021260
         DO    &D>0                                                     EM021270
         L     7,=A(XIO1)                                               EM021280
EMHKX10  CLI   0(7),X'00'                                               EM021290
         BE    EMHKX11                                                  EM021300
         L     10,XIOSAT                                                EM021310
         MVC   SATIOA,EMHKBUFR+1                                        EM021320
         L     11,EMHKBUFR                                              EM021330
         L     1,E2$RACSP                                               EM021340
******** SETCS START                                                    EM021350
         SETCS (1),R                                                    EM021360
******** SETCS END                                                      EM021370
HKOPN01  LA    1,GETCSIOA                                               EM021380
******** GETCS START                                                    EM021390
         GETCS (1)                                                      EM021400
******** GETCS END                                                      EM021410
         CLI   GETCSID,C'4'                                             EM021420
         BE    HKOPN01             SKIP TAPE CARD                       EM021430
         CLI   GETCSID,C'3'                                             EM021440
         BE    HKOPN01                                                  EM021450
         CLI   GETCSID,C'2'                                             EM021460
         BNE   HKOPN04                                                  EM021470
         CLC   DGCSDRV,XIODRV                                           EM021480
         BNE   HKOPN01              NOT THIS DRIVE                      EM021490
         CLC   DGCSMNT,XIOMNT                                           EM021500
         BNE   HKOPN01             NOT THIS MOUNT                       EM021510
         MVC   SATLFD+5(3),DGCSDVC                                      EM021520
         MVC   FCBLFD,SATLFD       LFD NAME TO FCB AREA                 EM021530
         MVC   FCBLNG,=H'256'      FCB LNG TO FCB AREA                  EM021540
         LR    1,11                FCB AREA ADDR INTO R1                EM021550
******** RDFCB START                                                    EM021560
         RDFCB (1)                                                      EM021570
******** RDFCB END                                                      EM021580
         MVC   FCBDSN1,DGCSDSN1                                         EM021590
         MVC   FCBDSN2,DGCSDSN2                                         EM021600
         MVC   FCBVSN,DGCSVOL                                           EM021610
         OI    SATFLG,X'04'        INDICATE TO SAT THAT FCB IS IN CORE  EM021620
         NI    SATSWT,X'AF'        SET OFF LACE AND VERIFY BITS         EM021630
         MVI   SATLACE,X'00'       INIT LACE FACTOR ZERO                EM021640
         CLI   DGCSLACE,C' '                                            EM021650
         BE    HKOPN02                                                  EM021660
         MVI   SATLACE,X'02'       SET LACE FACTOR                      EM021670
         OI    SATSWT,X'40'        SET ON LACE BIT                      EM021680
HKOPN02  CLI   DGCSVER,C' '                                             EM021690
         BE    HKOPN03                                                  EM021700
         TM    E2$RAMOD,X'04'                                           EM021710
         BO    HKOPN03                                                  EM021720
         OI    SATSWT,X'10'        SET SAT VERIFY BIT ON                EM021730
HKOPN03  LR    1,10                                                     EM021740
******** OPEN? START                                                    EM021750
         OPEN? (1)                                                      EM021760
******** OPEN? END                                                      EM021770
         TM    SATOFLG,X'80'                                            EM021780
         BZ    HKOPN04                                                  EM021790
         OI    XIOSWT,X'80'                                             EM021800
         DO    &CCC                                                     EM021810
         LA    0,SATPCA       ***** 8411 ONLY *****                     EM021820
         LR    1,10           ***** 8411 ONLY *****                     EM021830
******** GET?  START                                                    EM021840
         GET?  (1),(0)        ***** 8411 ONLY *****                     EM021850
******** GET?  END                                                      EM021860
         LR    1,10           ***** 8411 ONLY *****                     EM021870
******** WAITF? START                                                   EM021880
         WAITF? (1)           ***** 8411 ONLY *****                     EM021890
******** WAITF? END                                                     EM021900
         CLI   1361(11),C'C'  ***** 8411 ONLY *****                     EM021910
         BNE   HKOPN04        ***** 8411 ONLY *****                     EM021920
         OI    XIOSWT,X'40'   ***** 8411 ONLY *****                     EM021930
         ENDO                                                           EM021940
HKOPN04  LA    7,28(,7)                                                 EM021950
         B     EMHKX10                                                  EM021960
*                                                                       EM021970
EMHKX11  DS    0H                                                       EM021980
         ENDO                                                           EM021990
         DO    &T>0                                                     EM022000
         LM    1,3,EMHKCON2                                             EM022010
         SR    3,1                                                      EM022020
EMHKX12  CLI   0(2),X'00'                                               EM022030
         BE    EMHKX13                                                  EM022040
         L     1,0(,2)                                                  EM022050
         LA    1,0(1,3)                                                 EM022060
******** RDFCB START                                                    EM022070
         RDFCB (1)                                                      EM022080
******** RDFCB END                                                      EM022090
         LA    2,8(,2)                                                  EM022100
         B     EMHKX12                                                  EM022110
*                                                                       EM022120
EMHKX13  DS    0H                                                       EM022130
         ENDO                                                           EM022140
         TM    E2$RAMOD,X'04'                                           EM022150
         BO    EMHKX14                                                  EM022160
         L     13,EMHKCON1                                              EM022170
         DO    &T>0                                                     EM022180
         LM    0,1,EMHKCON3                                             EM022190
******** ATTACH START                                                   EM022200
         ATTACH (1),(0)                                                 EM022210
******** ATTACH END                                                     EM022220
         ENDO                                                           EM022230
         DO    &D>0                                                     EM022240
         LM    0,1,EMHKCON4                                             EM022250
******** ATTACH START                                                   EM022260
         ATTACH (1),(0)                                                 EM022270
******** ATTACH END                                                     EM022280
         ENDO                                                           EM022290
******** CHAP  START                                                    EM022300
         CHAP  1                                                        EM022310
******** CHAP  END                                                      EM022320
         DO    &T>0                                                     EM022330
         L     1,EMHKCON3+4                                             EM022340
******** WAIT  START                                                    EM022350
         WAIT  (1)                                                      EM022360
******** WAIT  END                                                      EM022370
         ENDO                                                           EM022380
         DO    &D>0                                                     EM022390
         L     1,EMHKCON4+4                                             EM022400
******** WAIT  START                                                    EM022410
         WAIT  (1)                                                      EM022420
******** WAIT  END                                                      EM022430
         ENDO                                                           EM022440
EMHKX14  DS    0H                                                       EM022450
         L     11,EMHKSAVE                                              EM022460
         BR    11                                                       EM022470
*                                                                       EM022480
*                                                                       EM022490
*  SUBROUTINE TO COMPRESS DISK XIO TABLE OR TAPE ADDR TABLE             EM022500
*                                                                       EM022510
EMHKXX   CLI   0(1),X'00'                                               EM022520
         BCR   8,14                END OF TABLE - EXIT                  EM022530
         TM    0(1),X'10'                                               EM022540
         BO    EMHKXX01            DRIVE USED                           EM022550
         LA    3,0(1,2)            POINT R3 TO NEXT ENTRY               EM022560
         LR    4,1                                                      EM022570
EMHKXX00 MVC   0(1,4),0(3)                                              EM022580
         CLI   0(3),X'00'                                               EM022590
         BE    EMHKXX                                                   EM022600
         AR    3,2                                                      EM022610
         AR    4,2                                                      EM022620
         B     EMHKXX00                                                 EM022630
*                                                                       EM022640
EMHKXX01 NI    0(1),X'8F'          RESET DRIVE USED BIT OFF             EM022650
         AR    1,2                 STEP R1 TO NEXT ENTRY                EM022660
         B     EMHKXX                                                   EM022670
*                                                                       EM022680
*                                                                       EM022690
EMHKCON1 DC    A(SVAREA1)                                               EM022700
*                                                                       EM022710
         DO    &T>0                                                     EM022720
EMHKCON2 DC    A(TP0)                                                   EM022730
         DC    A(TPADDRS)                                               EM022740
         DC    A(E2$TAPE0)                                              EM022750
*                                                                       EM022760
EMHKCON3 DC    A(IOTAPE)                                                EM022770
         DC    A(TAPEECB)                                               EM022780
*                                                                       EM022790
         ENDO                                                           EM022800
         DO    &D>0                                                     EM022810
EMHKCON4 DC    A(IODISK)                                                EM022820
         DC    A(DISKECB)                                               EM022830
*                                                                       EM022840
EMHKBUFR DC    F'0'                                                     EM022850
*                                                                       EM022860
         ENDO                                                           EM022870
*                                                                       EM022880
         LTORAR                                                         EM022890
*                                                                       EM022900
         PTCHAR 6                                                       EM022910
*                                                                       EM022920
         DROP  12                                                       EM022930
*                                                                       EM022940
         TITLE '360/20 DISC/TAPE EMULATOR - CSECT 25 - &NNN'            EM022950
*                                                                       EM022960
*                        SECOND HOUSEKEEPING IPL                        EM022970
*                                                                       EM022980
*                                                                       EM022990
*                                                                       EM023000
*        THIS CSECT WILL OVERLAY OVAREA - CSECT 23                      EM023010
*                                                                       EM023020
*                                                                       EM023030
&W       SET   '&NNN'.'25'                                              EM023040
&W       CSCTAR                                                         EM023050
*                                                                       EM023060
*                                                                       EM023070
         USING EMHKSVX,12                                               EM023080
*                                                                       EM023090
*                                                                       EM023100
EMHKSVX  DC    F'0'                                                     EM023110
*                                                                       EM023120
*                                                                       EM023130
*  2ND ENTRANCE TO HOUSEKEEPING  -  EMHK00X IF NO IPL                   EM023140
*                                   EMHK00 IF DISK OR TAPE IPL          EM023150
*                                                                       EM023160
*                                                                       EM023170
         DO    &D>0                                                     EM023180
*                                                                       EM023190
*  SUBROUTINE TO GET BUFFER FROM OS FREE AREA                           EM023200
*                                                                       EM023210
EMHKOSB GETINF PRE,PREINF,8,16                                          EM023220
         LM    1,2,PREINF          UPPER LIMIT IN R1 - NEXT BYTE IN R2  EM023230
         LA    2,3(,2)             ENSURE FULL                          EM023240
         N     2,EMHKMASK            WORD BOUNDRY                       EM023250
         L     4,=A(BUFFER01)                                           EM023260
EMHKOSBX LA    3,1556(,2)                                               EM023270
         CR    3,1                                                      EM023280
         BCR   2,7                 EXIT IF HIGH - NO MORE SPACE         EM023290
         ST    2,BCBNBA                                                 EM023300
         LR    4,2                                                      EM023310
         XC    BCBUNIT(20),BCBUNIT                                      EM023320
         LR    2,3                                                      EM023330
         B     EMHKOSBX                                                 EM023340
*                                                                       EM023350
*                                                                       EM023360
*                                                                       EM023370
*  SUBROUTINE TO LOAD EOJ/FETCH PHASE IF CORE IS AVAILABLE              EM023380
*                                                                       EM023390
*        AT ENTRANCE R2 POINTS TO NEXT AVAILABLE BYTE                   EM023400
*                    R1 POINTS TO UPPER LIMIT                           EM023410
*                                                                       EM023420
EMHKLOAD LM    4,5,EFCONS          COMPARE NEXT AVAILABLE               EM023430
         SR    5,4                   BYTE PLUS LENGTH                   EM023440
         LA    3,0(5,2)              OF PHASE TO                        EM023450
         CR    3,1                   UPPER LIMIT                        EM023460
         BCR   2,7                 EXIT IF HIGH                         EM023470
         ST    2,BASE26            SAVE LOAD ADDR                       EM023480
         LM    4,5,EFCONS+8        CALCULATE                            EM023490
         S     4,EFCONS              AND                                EM023500
         S     5,EFCONS              SAVE                               EM023510
         AR    4,2                   ENTRANCE                           EM023520
         AR    5,2                   POINT                              EM023530
         STM   4,5,PHASE3            ADDRS                              EM023540
         LR    0,2                 PUT LOAD ADDR INTO R0                EM023550
         LA    1,PROG              PUT ADDR OF PHASE NAME INTO R1       EM023560
         MVI   PHASE,C'6'          FILL IN LAST BYTE OF PHASE NAME      EM023570
******** LOAD  START                                                    EM023580
         LOAD  (1),(0)                                                  EM023590
******** LOAD  END                                                      EM023600
         LR    2,3                 NEXT AVAILABLE BYTE INTO R2          EM023610
         BR    7                   EXIT                                 EM023620
*                                                                       EM023630
EFCONS   DC    A(EOJFETSV)                                              EM023640
         DC    A(EOJFTEND)                                              EM023650
         DC    A(EOJ)                                                   EM023660
         DC    A(FETCH)                                                 EM023670
*                                                                       EM023680
*                                                                       EM023690
         ENDO                                                           EM023700
*                                                                       EM023710
*  NO IPL                                                               EM023720
*                                                                       EM023730
EMHK00X  ST    11,EMHKSVX                                               EM023740
         MVC   E2$RAPRF+4(4),GENPARS         SET GEN PARAMS IN ADDR TAB EM023750
         MVC   E2$RAORF+4(4),VERDATE         SET VER DATE IN ADDR TAB   EM023760
         DO    &D>0                                                     EM023770
         BAL   7,EMHKOSB                                                EM023780
         ENDO                                                           EM023790
         TM    E2$RATPS,X'01'                SET I/O TRAP               EM023800
         BZ    PASTIOT                       NO - BRANCH                EM023810
         MVI   PGMIOREQ,X'FF'                INVALOP FOR I/O REQUEST    EM023820
PASTIOT  EQU   *                                                        EM023830
         B     EMHKEXIT                                                 EM023840
         OI    E2$RAPUB,X'80'                SET DATE/PUB LENGTH INDIC  EM023850
*********************************************************************** EM023860
*                                                                     * EM023870
*                        CALL TO TRANSIENT                            * EM023880
*                                                                     * EM023890
*********************************************************************** EM023900
         SVC   SV$E2A                                                   EM023910
EMHKEXIT DS    0H                                                       EM023920
         DO    &CCC                                                     EM023930
         L     4,=A(BUFFER01)                                           EM023940
         L     4,BCBNBA                                                 EM023950
         LTR   4,4                                                      EM023960
         BNZ   EMHKOK                                                   EM023970
         LA    0,600               X'258' COMPLETION CODE - NO EXTRA    EM023980
         ORG   *-2                                                      EM023990
         DC    XL2'0558'                                                EM024000
         L     15,=A(DSKTPERR)       BUFFER FOR DISK FETCH AND/OR 8411  EM024010
         BR    15                  GO CLOSE AND DUMP                    EM024020
*                                                                       EM024030
EMHKOK   DS    0H                                                       EM024040
         ENDO                                                           EM024050
         L     11,EMHKSVX                                               EM024060
         BR    11                                                       EM024070
*                                                                       EM024080
*                                                                       EM024090
*                                                                       EM024100
GENPARS  DS    0H                                                       EM024110
         DC    YL1(&D)                       NUMBER OF DISC DRIVES      EM024120
         DC    YL1(&T)                       NUMBER OF TAPE DRIVES      EM024130
         DC    YL1(&SSS)                     SEPAS=YES - 01             EM024140
         DC    YL1(&CCC)                     COMP=YES - 01              EM024150
VERDATE  DC    PL4'760801'              VERSION DATE                    EM024160
*                                                                       EM024170
*                                                                       EM024180
*  IPL                                                                  EM024190
*                                                                       EM024200
EMHK00   ST    11,EMHKSVX                                               EM024210
         MVC   E2$RAPRF+4(4),GENPARS         SET GEN PARAMS IN ADDR TAB EM024220
         MVC   E2$RAORF+4(4),VERDATE         SET VER DATE IN ADDR TAB   EM024230
         DO    &D>0                                                     EM024240
         BAL   7,EMHKOSB                                                EM024250
         BAL   7,EMHKLOAD          LOAD EOJ/FETCH IF CORE AVAILABLE     EM024260
         ENDO                                                           EM024270
         LA    11,4088(,8)         USE 20 AREA ABOVE MONITOR AS BUFR    EM024280
         L     1,E2$RACSP                                               EM024290
******** SETCS START                                                    EM024300
         SETCS (1),R                                                    EM024310
******** SETCS END                                                      EM024320
IPL00    LA    1,GETCSIOA                                               EM024330
******** GETCS START                                                    EM024340
         GETCS (1)                                                      EM024350
******** GETCS END                                                      EM024360
         DO    &D>0                                                     EM024370
         CLI   GETCSID,C'2'                                             EM024380
         BE    IPL01               DISK CARD                            EM024390
         ENDO                                                           EM024400
         DO    &T>0                                                     EM024410
         CLI   GETCSID,C'4'                                             EM024420
         BE    IPL02               TAPE CARD                            EM024430
         ENDO                                                           EM024440
         CLI   GETCSID,C'3'                                             EM024450
         BE    IPL00               IGNORE TYPE 3 CARD                   EM024460
         DO    &D>0                                                     EM024470
         DO    &T>0                                                     EM024480
         TM    E2$RAMOD,X'40'                                           EM024490
         BO    IPL03               TPS                                  EM024500
         ENDO                                                           EM024510
         B     IPL08               DPS                                  EM024520
         ENDO                                                           EM024530
         DO    &D=0                                                     EM024540
         B     IPL03               TPS                                  EM024550
         ENDO                                                           EM024560
*                                                                       EM024570
         DO    &D>0                                                     EM024580
IPL01    CLI   DGCSRES,C' '                                             EM024590
         BE    IPL00                                                    EM024600
         MVN   DPSRES,DGCSDRV      SAVE DISK SYSRES DRIVE               EM024610
         B     IPL00                                                    EM024620
*                                                                       EM024630
         ENDO                                                           EM024640
         DO    &T>0                                                     EM024650
IPL02    CLI   TGCSRES,C' '                                             EM024660
         BE    IPL00                                                    EM024670
         MVN   TPSRES,TGCSDRV      SAVE TAPE SYSRES DRIVE               EM024680
         B     IPL00                                                    EM024690
*                                                                       EM024700
IPL03    L     2,=A(TPADDRS)                                            EM024710
IPL04    CLC   TPSRES,0(2)                                              EM024720
         BE    IPL06               FOUND SYSRES TAPE IN TBL             EM024730
         CLI   0(2),X'00'                                               EM024740
         BE    IPL05                                                    EM024750
         LA    2,8(,2)                                                  EM024760
         B     IPL04                                                    EM024770
*                                                                       EM024780
IPL05    LA    0,617               X'269' COMPLETION CODE - NO GETCS    EM024790
         ORG   *-2                                                      EM024800
         DC    XL2'0569'                                                EM024810
         L     15,=A(DSKTPERR)       CARD FOR SYSRES TAPE DRIVE         EM024820
         BR    15                  GO CLOSE AND DUMP                    EM024830
*                                                                       EM024840
IPL06    CLI   4(2),X'C0'                                               EM024850
         BE    IPL07               TAPE IS 9-TRACK                      EM024860
         B     IPL07                                                    EM024870
         LA    0,615               X'267' COMPLETION CODE - TAPE ON     EM024880
         ORG   *-2                                                      EM024890
         DC    XL2'0567'                                                EM024900
         L     15,=A(DSKTPERR)       SYSRES DRIVE IS NOT 9-TRACK        EM024910
         BR    15                  GO CLOSE AND DUMP                    EM024920
*                                                                       EM024930
IPL07    L     3,0(,2)             CCB ADDR INTO R3                     EM024940
         LA    3,0(,3)             CLEAR HIGH ORDER BYTE                EM024950
         L     4,=A(IOTCCW)                                             EM024960
         LA    1,144                                                    EM024970
         ST    1,0(,4)             I/O AREA ADDR INTO CCW               EM024980
         MVC   4(4,R4),=X'0FFF0001'          BYTE COUNT AND BLOCK COUNT EM024990
         MVI   0(4),X'07'          REWIND CC INTO CCW                   EM025000
         LR    1,3                                                      EM025010
         TM    2(1),X'80'                                               EM025020
         BZ    *-4                                                      EM025030
******** EXCP  START                                                    EM025040
         EXCP  (1)                                                      EM025050
******** EXCP  END                                                      EM025060
         LR    1,3                                                      EM025070
         TM    2(1),X'80'                                               EM025080
         BZ    *-4                                                      EM025090
         MVI   0(4),X'02'          READ CC INTO CCW                     EM025100
IPL07LP  EQU   *                                                        EM025110
******** EXCP  START                                                    EM025120
         EXCP  (1)                 READ                                 EM025130
******** EXCP  END                                                      EM025140
         LR    1,3                                                      EM025150
         TM    2(1),X'80'                                               EM025160
         BZ    *-4                                                      EM025170
         TM    2(R1),X'20'                   UNIQUE ERROR               EM025180
         BO    IPL07LP                       YES - BRANCH               EM025190
******** EXCP  START                                                    EM025200
         EXCP  (1)                 READ                                 EM025210
******** EXCP  END                                                      EM025220
         TM    2(3),X'80'                                               EM025230
         BZ    *-4                                                      EM025240
         TM    2(3),X'08'                                               EM025250
         BO    IPL19               TAPE MARK MUST FOLLOW MONITOR        EM025260
         LA    0,614               X'266' COMPLETION CODE - TAPE ON     EM025270
         ORG   *-2                                                      EM025280
         DC    XL2'0566'                                                EM025290
         L     15,=A(DSKTPERR)       SYSRES DRIVE IS NOT A SYSRES       EM025300
         BR    15                  GO CLOSE AND DUMP                    EM025310
*                                                                       EM025320
         ENDO                                                           EM025330
         DO    &D>0                                                     EM025340
IPL08    L     7,=A(XIO1)                                               EM025350
IPL09    CLC   DPSRES,XIOUNIT                                           EM025360
         BE    IPL10               FOUND SYSRES DRIVE IN XIO TBL        EM025370
         CLI   XIOUNIT,X'00'                                            EM025380
         BE    IPL11                                                    EM025390
         LA    7,28(,7)                                                 EM025400
         B     IPL09                                                    EM025410
*                                                                       EM025420
IPL10    TM    XIOSWT,X'80'                                             EM025430
         BO    IPL12               DRIVE IS MOUNTED                     EM025440
IPL11    LA    0,610               X'262' COMPLETION CODE - NO MNT 00   EM025450
         ORG   *-2                                                      EM025460
         DC    XL2'0562'                                                EM025470
         L     15,=A(DSKTPERR)       GETCS CARD FOR SYSRES DISK DRIVE   EM025480
         BR    15                  GO CLOSE AND DUMP                    EM025490
*                                                                       EM025500
IPL12    L     10,XIOSAT                                                EM025510
         L     1,=A(FETADDRS)                                           EM025520
         ST    7,0(,1)             SAVE SYSRES XIO ADDR AND             EM025530
         ST    10,4(,1)              SAT ADDR FOR FETCH RTN             EM025540
         MVC   SATSRB,=H'1'                                             EM025550
         LA    0,SATPCA                                                 EM025560
         LR    1,10                                                     EM025570
******** GET?  START                                                    EM025580
         GET?  (1),(0)                                                  EM025590
******** GET?  END                                                      EM025600
         TM    SATWAIT,X'80'                                            EM025610
         BZ    *-4                                                      EM025620
         LR    1,10                                                     EM025630
******** WAITF? START                                                   EM025640
         WAITF? (1)                                                     EM025650
******** WAITF? END                                                     EM025660
         LA    9,4088(,8)                                               EM025670
         DO    &CCC                                                     EM025680
         TM    XIOSWT,X'40'   ***** 8411 ONLY *****                     EM025690
         BZ    *+8            ***** 8411 ONLY *****                     EM025700
         LA    9,1401(,9)     ***** 8411 ONLY *****                     EM025710
         ENDO                                                           EM025720
         CLC   50(6,9),=C'SYSRES'                                       EM025730
         BE    IPL13                                                    EM025740
         LA    0,613               X'265' COMPLETION CODE - PACK ON     EM025750
         ORG   *-2                                                      EM025760
         DC    XL2'0565'                                                EM025770
         L     15,=A(DSKTPERR)       SYSRES DRIVE IS NOT A SYSRES       EM025780
         BR    15                  GO CLOSE AND DUMP                    EM025790
*                                                                       EM025800
IPL13    MVC   SATSRB,=H'81'                                            EM025810
         DO    &CCC                                                     EM025820
         TM    XIOSWT,X'40'   ***** 8411 ONLY *****                     EM025830
         BZ    *+10           ***** 8411 ONLY *****                     EM025840
         MVC   SATSRB,=H'1'   ***** 8411 ONLY *****                     EM025850
         ENDO                                                           EM025860
         LA    0,SATPCA            PCA ADDR INTO R0                     EM025870
         LR    1,10                SAT ADDR INTO R1                     EM025880
******** GET?  START                                                    EM025890
         GET?  (1),(0)                                                  EM025900
******** GET?  END                                                      EM025910
         TM    SATWAIT,X'80'                                            EM025920
         BZ    *-4                                                      EM025930
         LR    1,10                SAT ADDR BACK INTO R1                EM025940
******** WAITF? START                                                   EM025950
         WAITF? (1)                                                     EM025960
******** WAITF? END                                                     EM025970
         LA    9,4088(,8)                                               EM025980
         MVC   144(216,8),270(9)   MOVE                                 EM025990
         MVC   360(216,8),486(9)     RECORDS                            EM026000
         MVC   576(216,8),702(9)       1 THRU 4                         EM026010
         MVC   792(216,8),918(9)         TO 360-20                      EM026020
         MVC   1008(216,8),1134(9)         MONITOR AREA                 EM026030
         MVI   PGMIOREQ,X'FF'      INVALID OP CODE FOR I/O REQUEST      EM026040
         MVI   PGMEOJ,X'FF'        INVALID OP CODE FOR EOJ              EM026050
         MVI   PGMFETCH,X'FF'      INVALID OP CODE FOR FETCH            EM026060
         LH    0,PGMINTRT          INT RTN ADDR INTO R0                 EM026070
         LR    2,0                   AND R2                             EM026080
         LA    1,PROG              LOAD COMPRESSED                      EM026090
         MVI   PHASE,C'9'            INT RTN                            EM026100
******** LOAD  START                                                    EM026110
         LOAD  (1),(0)                                                  EM026120
******** LOAD  END                                                      EM026130
         BAL   14,64(,2)           LINK TO RELOCATE INT RTN             EM026140
         LH    1,PGMSMIOA          START MON I/O AREA ADDR INTO R1      EM026150
         LH    2,PGMEMIOA          END MON I/O AREA ADDR INTO R2        EM026160
         LH    3,PGMCR             COM REG ADDR INTO R3                 EM026170
         STH   2,PGMEMON      END I/O AREA TO - END MON ADDR            EM026180
         STH   2,PGMEMMR                        END MON MV RTN ADDR     EM026190
         STH   2,PGMETER                        END TP ERR RTN ADDR     EM026200
         STH   2,PGMETS                         END TP STATS RTN ADDR   EM026210
         LH    2,PGMINTRT          POINT R2 TO                          EM026220
         LA    2,79(,2)              1ST FULL WORD                      EM026230
         N     2,EMHKMASK            ABOVE NEW INT RTN                  EM026240
         SR    11,11                                                    EM026250
         L     5,=A(BUFFER01)                                           EM026260
IPL16    LA    11,1(,11)           COUNT BUFRS                          EM026270
         LR    4,5                                                      EM026280
         L     5,BCBNBA                                                 EM026290
         LTR   5,5                                                      EM026300
         BNZ   IPL16                                                    EM026310
IPL17    LA    3,1556(,2)                                               EM026320
         CR    3,1                                                      EM026330
         BNL   IPL18               NOT ENOUGH ROOM FOR A BUFFER         EM026340
         LA    11,1(,11)           ADD TO BUFR COUNT                    EM026350
         ST    2,BCBNBA            POINTER TO NEXT BCB INTO CURRENT BCB EM026360
         LR    4,2                 SET BASE REG TO MAKE NEW BCB CURRENT EM026370
         XC    BCBUNIT(20),BCBUNIT                                      EM026380
         LR    2,3                                                      EM026390
         B     IPL17               GO CHECK IF ROOM FOR ANOTHER BUFFER  EM026400
*                                                                       EM026410
IPL18    STH   11,HKWORK           SAVE BUFR COUNT                      EM026420
         L     11,BASE26                                                EM026430
         LTR   11,11                                                    EM026440
         BNZ   IPL19               EOJ/FETCH ALREADY LOADED             EM026450
         BAL   7,EMHKLOAD          LOAD EOJ/FETCH IF CORE AVAILABLE     EM026460
         L     11,BASE26                                                EM026470
         LTR   11,11                                                    EM026480
         BNZ   IPL19               EOJ/FETCH ALREADY LOADED             EM026490
         CLC   HKWORK,MINBUF                                            EM026500
         BNH   IPL19               NO EXTRA BUFFER                      EM026510
         L     4,=A(BUFFER01)      MAKE 1ST BCB                         EM026520
         LA    5,BCBNBA              POINTER TO                         EM026530
         L     4,BCBNBA              NEXT BCB                           EM026540
         MVC   0(4,5),BCBNBA         POINT TO 3RD                       EM026550
         LR    2,4                   BCB AND LOAD                       EM026560
         LA    1,1556(,2)            EOJ/FETCH IN                       EM026570
         BAL   7,EMHKLOAD            2ND BUFFER                         EM026580
         ENDO                                                           EM026590
IPL19    MVC   E2$RAPPS+6(2),=H'194'    SET 360-20 PSW TO GO TO EOJ     EM026600
         LH    1,PGMSLUB                                                EM026610
         LH    2,PGMSPUB                                                EM026620
         LH    3,PGMCR                                                  EM026630
         DO    &D=0                                                     EM026640
         B     IPL19PST                                                 EM026650
         ENDO                                                           EM026660
         OI    E2$RAPUB,X'80'           SET DATE/PUB LENGTH INDICATOR   EM026670
*********************************************************************** EM026680
*                                                                     * EM026690
*                        CALL TO TRANSIENT                            * EM026700
*                                                                     * EM026710
*********************************************************************** EM026720
         SVC   SV$E2A                   CALL ROOT TRANSIENT             EM026730
         DO    &D>0                                                     EM026740
         MVC   IPL20I+3(0),E2$RAPUB     INSERT PUB LENGTH IN INSTRUCTON EM026750
         ENDO                                                           EM026760
         DO    &D=0                                                     EM026770
         MVC   IPL21I+3(1),E2$RAPUB          INSERT PUB LENGTH          EM026780
IPL19PST EQU   *                                                        EM026790
         ENDO                                                           EM026800
         DO    &D>0                                                     EM026810
IPL20    CLC   DSYSRES,0(2)                                             EM026820
         BE    IPL23                                                    EM026830
IPL20I   LA    R2,0(,R2)                ADJUST TO NEXT PUB              EM026840
*                                                                       EM026850
         CH    2,PGMEPUB                                                EM026860
         BNH   IPL20                                                    EM026870
         DO    &T>0                                                     EM026880
         B     IPL22                                                    EM026890
*                                                                       EM026900
         ENDO                                                           EM026910
         ENDO                                                           EM026920
         DO    &T>0                                                     EM026930
IPL21    CLC   TSYSRES,0(2)                                             EM026940
         BE    IPL23                                                    EM026950
IPL21I   LA    R2,6(,R2)                     ADJUST TO NEXT PUB         EM026960
         CH    2,PGMEPUB                                                EM026970
         BNH   IPL21                                                    EM026980
         DO    &D>0                                                     EM026990
IPL22    DS    0H                                                       EM027000
         ENDO                                                           EM027010
         ENDO                                                           EM027020
         LA    0,612               X'264' COMPLETION CODE - NO PUB FOR  EM027030
         ORG   *-2                                                      EM027040
         DC    XL2'0564'                                                EM027050
         L     15,=A(DSKTPERR)       SYSRES                             EM027060
         BR    15                  GO CLOSE AND DUMP                    EM027070
*                                                                       EM027080
IPL23    STH   2,0(,1)             INIT SYSRES LUB                      EM027090
         MVC   2(2,1),E2$RASRD     INIT SYSRDR LUB                      EM027100
         DO    &D>0                                                     EM027110
         DO    &T>0                                                     EM027120
         TM    E2$RAMOD,X'40'                                           EM027130
         BO    EMHKEXIT                                                 EM027140
         ENDO                                                           EM027150
         NC    PGMMSTAT,=X'EDFB'   SET MONITOR STATUS FOR NO BSCA       EM027160
         NI    PGMCB2,X'9F'        INIT COM REG TAPE BITS               EM027170
         MVI   PGMCONFG,X'00'      INIT COMREG CONFG BYTE               EM027180
         STH   6,HKWORK                                                 EM027190
         TM    HKWORK,X'60'                                             EM027200
         BM    IPL24                                                    EM027210
         OI    PGMCONFG,X'40'                                           EM027220
         OI    PGMCONFG,X'40'                                           EM027230
         B     IPL25                                                    EM027240
*                                                                       EM027250
IPL24    OI    PGMCONFG,X'20'                                           EM027260
IPL25    TM    HKWORK,X'20'                                             EM027270
         DO    &CCC=0                                                   EM027280
         BZ    *+8                                                      EM027290
         OI    PGMCONFG,X'80'                                           EM027300
         L     4,=A(BUFFER01)                                           EM027310
         L     4,BCBNBA                                                 EM027320
         LTR   4,4                                                      EM027330
         BNZ   EMHKEXIT                                                 EM027340
         LA    0,600               X'258' COMPLETION CODE - NO EXTRA    EM027350
         ORG   *-2                                                      EM027360
         DC    XL2'0558'                                                EM027370
         L     15,=A(DSKTPERR)       BUFFER FOR DISK FETCH              EM027380
         BR    15                  GO CLOSE AND DUMP                    EM027390
*                                                                       EM027400
         ENDO                                                           EM027410
         DO    &CCC                                                     EM027420
         BZ    EMHKEXIT                                                 EM027430
         OI    PGMCONFG,X'80'                                           EM027440
         B     EMHKEXIT                                                 EM027450
*                                                                       EM027460
         ENDO                                                           EM027470
         ENDO                                                           EM027480
         DO    &D=0                                                     EM027490
         B     EMHKEXIT                                                 EM027500
*                                                                       EM027510
         ENDO                                                           EM027520
         DO    &D>0                                                     EM027530
*                                                                       EM027540
EMHKMASK DS    0F                                                       EM027550
         DC    X'FFFFFFFC'                                              EM027560
*                                                                       EM027570
*                                                                       EM027580
PREINF   DC    2F'0'                                                    EM027590
*                                                                       EM027600
*                                                                       EM027610
HKWORK   DC    H'0'                                                     EM027620
&W       SET   &D+&D+&CCC                                               EM027630
MINBUF   DC    H'&W'                                                    EM027640
*                                                                       EM027650
*                                                                       EM027660
DSYSRES  DS    0CL2                                                     EM027670
         DC    X'08'                                                    EM027680
DPSRES   DC    X'01'                                                    EM027690
*                                                                       EM027700
         ENDO                                                           EM027710
         DO    &T>0                                                     EM027720
*                                                                       EM027730
TSYSRES  DS    0CL2                                                     EM027740
         DC    X'07'                                                    EM027750
TPSRES   DC    X'80'                                                    EM027760
*                                                                       EM027770
         ENDO                                                           EM027780
*                                                                       EM027790
         LTORAR                                                         EM027800
*                                                                       EM027810
*                                                                       EM027820
         DROP  12                                                       EM027830
*                                                                       EM027840
         TITLE '360/20 DISC/TAPE EMULATOR - CSECT 26 - &NNN'            EM027850
*                                                                       EM027860
*                        EOJ AND FETCH                                  EM027870
*                                                                       EM027880
*                                                                       EM027890
*                                                                       EM027900
*        THIS CSECT WILL OVERLAY OVAREA - CSECT 23                      EM027910
*                                                                       EM027920
*                                                                       EM027930
&W       SET   '&NNN'.'26'                                              EM027940
&W       CSCTAR                                                         EM027950
*                                                                       EM027960
*                                                                       EM027970
         USING EOJFETSV,12                                              EM027980
*                                                                       EM027990
*                                                                       EM028000
EOJFETSV DC    F'0'                                                     EM028010
*                                                                       EM028020
*                                                                       EM028030
         DO    &D=0                                                     EM028040
EOJ      LA    0,608               X'260' COMPLETION CODE - DISK EOJ    EM028050
         ORG   *-2                                                      EM028060
         DC    XL2'0560'                                                EM028070
         L     15,=A(DSKTPERR)       WITH NO DISK                       EM028080
         BR    15                  GO CLOSE AND DUMP                    EM028090
*                                                                       EM028100
*                                                                       EM028110
FETCH    LA    0,601               X'259' COMPLETION CODE - DISK FETCH  EM028120
         ORG   *-2                                                      EM028130
         DC    XL2'0559'                                                EM028140
         L     15,=A(DSKTPERR)       WITH NO DSIK                       EM028150
         BR    15                  GO CLOSE AND DUMP                    EM028160
*                                                                       EM028170
*                                                                       EM028180
         ENDO                                                           EM028190
         DO    &D>0                                                     EM028200
EOJ      LH    3,PGMCR                                                  EM028210
         MVC   PGMNAME,=C'SYSEND'  PGM NAME TO PLDA                     EM028220
         TM    E2$RATPS,X'80'                USE SYSEOJ                 EM028230
         BZ    JOBCNT20                      NO - BRANCH                EM028240
         MVC   PGMNAME+4(2),=C'OJ'           SET SYSEOJ                 EM028250
JOBCNT20 EQU   *                                                        EM028260
         MVI   PGMSUBPH,X'0C'      SUB-PHASE TO PLDA                    EM028270
         XC    PGMCDINT,PGMCDINT   RESET CARD INTERRUPT ADDR            EM028280
         NI    PGMCB1,X'FE'        RESET TEMP JOB BIT                   EM028290
         OI    E2$RASWB,X'40'           SET 360/20 CONTROL SCAN BIT     EM028300
         MVI   E2$RAJOB,X'40'           BLANK OUT THE                   EM028310
         MVC   E2$RAJOB+1(5),E2$RAJOB     STORED JOBNAME                EM028320
FETCH    ST    11,EOJFETSV                                              EM028330
         L     4,=A(BUFFER01)                                           EM028340
         CLC   BCBNBA(4),=F'0'                                          EM028350
         BE    *+8                                                      EM028360
         L     4,BCBNBA                                                 EM028370
         LA    4,BCBBUFR                                                EM028380
         ST    4,FETBUFAD                                               EM028390
         XC    FETSRB,FETSRB                                            EM028400
         LH    3,PGMCR                                                  EM028410
         L     1,=A(FETADDRS)                                           EM028420
         L     7,0(,1)                                                  EM028430
         MVI   FETCOMP,X'00'                                            EM028440
         TM    PGMCB1,X'01'                                             EM028450
         BZ    FET003              NOT TEMPORARY JOB                    EM028460
         MVI   FETCOMP,X'F1'                                            EM028470
FET003   MVC   FETCOMP+1(7),PGMPGMID    PGM ID TO COMPARE FIELD         EM028480
         MVC   FETCHR,=XL6'000400030009'     INIT CYL HD REC            EM028490
FET004   BAL   5,FETSTEP           STEP CHR                             EM028500
         BAL   5,FETGET            GET A SECTOR                         EM028510
         CLC   FETCOMP,241(11)     R11 POINTS TO SECTOR                 EM028520
         BH    FET004                                                   EM028530
FET005   CLC   FETCOMP,1(11)                                            EM028540
         BE    FET007              FOUND                                EM028550
         BL    FET006              ERROR                                EM028560
         LA    11,30(,11)                                               EM028570
         B     FET005              CHECK NEXT ENTRY                     EM028580
*                                                                       EM028590
FET006   CLC   PGMNAME,=C'SYSEND'                                       EM028600
         BNE   FET006A                                                  EM028610
FET006X  MVC   PGMNAME+4(2),=C'OJ' TRY SYSEOJ INSTEAD OF SYSEND         EM028620
         B     FET003                                                   EM028630
*                                                                       EM028640
FET006A  MVC   E2$RAHIB,=X'0B220000'                                    EM028650
         B     FET016                                                   EM028660
*                                                                       EM028670
FET007   TM    PGMCB3,X'08'        TEST LOAD BIT                        EM028680
         BZ    FET008                                                   EM028690
         L     10,E2$RAPRA                                              EM028700
         LH    1,0(,10)            ADJUST                               EM028710
         SH    1,14(,11)                                                EM028720
         AH    1,20(,11)             LOAD                               EM028730
         STH   1,20(,11)                                                EM028740
         MVC   14(2,11),0(10)          ADDR                             EM028750
         LA    10,2(,10)           ADJUST                               EM028760
         STH   10,24(,11)            XFR ADDR                           EM028770
         NI    PGMCB3,X'F7'        RESET LOAD BIT                       EM028780
FET008   MVC   FETSAVE,16(11)      SAVE INFO FOR LOAD OF LAST BLOCK     EM028790
         MVC   PGMVERMD,26(11)     VER AND MOD TO COMM REG              EM028800
         CLC   14(2,11),PGMEMIOA   CHK IF LOAD ADDR IS ABOVE MONITOR    EM028810
         BH    FET009                                                   EM028820
         CLC   PGMNAME,=C'SYSEND'                                       EM028830
         BE    FET006X             GO TRY SYSEOJ INSTEAD OF SYSEND      EM028840
         MVC   E2$RAHIB,=X'0B230000'                                    EM028850
         B     FET016                                                   EM028860
*                                                                       EM028870
FET009   CLI   13(11),X'00'        CHK IF ANY FULL SECTORS              EM028880
         BE    FET013              NO                                   EM028890
         MVC   FETCHR+1(3),9(11)   SET UP                               EM028900
         MVC   FETREC+1(1),12(11)    INIT CHR                           EM028910
         SR    10,10               SECTOR COUNT                         EM028920
         IC    10,13(,11)            INTO R10                           EM028930
         LH    9,14(,11)           LOAD ADDR INTO R9                    EM028940
FET010   LA    5,270(,9)           CHK IF SECTOR                        EM028950
         CR    5,6                   WILL EXCEED                        EM028960
         BNH   FET011                  360/20 CORE                      EM028970
FET010A  MVC   E2$RAHIB,=X'0B230000'                                    EM028980
         B     FET016                                                   EM028990
*                                                                       EM029000
FET011   BAL   5,FETGET            GET A SECTOR                         EM029010
         MVC   0(200,9),0(11)      MOVE SECTOR TO                       EM029020
         MVC   200(70,9),200(11)     LOAD ADDR                          EM029030
         LA    9,270(,9)           STEP LOAD ADDR                       EM029040
         BCT   10,FET012           DECRA SECTOR COUNT - BRANCH IF MORE  EM029050
         B     FET013              LAST FULL SECTOR                     EM029060
*                                                                       EM029070
FET012   BAL   5,FETSTEP           STEP CHR                             EM029080
         B     FET010                                                   EM029090
*                                                                       EM029100
FET013   MVC   FETCHR+1(3),FETSAVE                                      EM029110
         MVC   FETREC+1(1),FETSAVE+3                                    EM029120
         LH    9,FETSAVE+4                                              EM029130
         LH    10,FETSAVE+6                                             EM029140
         LA    5,0(9,10)           CHK IF REMAINDER                     EM029150
         CR    5,6                   WILL FIT IN                        EM029160
         BH    FET010A                 360/20 CORE                      EM029170
         BAL   5,FETGET            GET SECTOR CONTAINING REMAINDER      EM029180
         LA    5,256                                                    EM029190
         CR    10,5                                                     EM029200
         BNH   FET014                                                   EM029210
         MVC   0(256,9),0(11)      MOVE 1ST 256 BYTES                   EM029220
         AR    9,5                                                      EM029230
         AR    11,5                                                     EM029240
         SR    10,5                                                     EM029250
FET014   BCTR  10,0                                                     EM029260
         STC   10,FET015+1                                              EM029270
FET015   MVC   0(1,9),0(11)        MOVE REMAINDER                       EM029280
         MVC   E2$RAPPS+6(2),FETSAVE+8  MOVE XFR ADDR TO 360-20 PSW     EM029290
         B     FET017                                                   EM029300
*                                                                       EM029310
FET016   LA    15,FET017           ERROR EXIT                           EM029320
         ST    15,E2$RAHIB+4                                            EM029330
*********************************************************************** EM029340
*                                                                     * EM029350
*                        CALL TO TRANSIENT                            * EM029360
*                                                                     * EM029370
*********************************************************************** EM029380
         SVC   SV$E2C                                                   EM029390
FET017   NI    E2$RAMOD,X'FC'      NORMAL EXIT - RESET MONITOR IN USE   EM029400
*                                         BIT & ACTUAL UNIT IN CCB BIT  EM029410
         CLC   PGMNAME,=C'SYSEND'       RESET THE 360/20                EM029420
         BE    FET017A                    CONTROL CARD SCAN             EM029430
         CLC   PGMNAME,=C'SYSEOJ'         BIT IF PROGRAM NAME           EM029440
         BE    FET017A                    IS NOT SYSEND                 EM029450
         NI    E2$RASWB,X'BF'             OR SYSEOJ                     EM029460
FET017A  L     R11,EOJFETSV                                             EM029470
         BR    11                  EXIT                                 EM029480
*                                                                       EM029490
*                                                                       EM029500
*  SUBROUTINE TO STEP CHR                                               EM029510
*                                                                       EM029520
FETSTEP  CLI   FETREC+1,X'09'                                           EM029530
         BE    FETSTP01                                                 EM029540
         AI    FETREC,X'01'                                             EM029550
         BR    5                                                        EM029560
*                                                                       EM029570
FETSTP01 MVI   FETREC+1,X'00'                                           EM029580
         CLI   FETHEAD+1,X'09'                                          EM029590
         BE    FETSTP02                                                 EM029600
         AI    FETHEAD,X'01'                                            EM029610
         BR    5                                                        EM029620
*                                                                       EM029630
FETSTP02 MVI   FETHEAD+1,X'00'                                          EM029640
         CLI   FETCYL+1,X'CA'                                           EM029650
         BNL   FETSTP03                                                 EM029660
         AI    FETCYL,X'01'                                             EM029670
         BR    5                                                        EM029680
*                                                                       EM029690
FETSTP03 MVC   E2$RAHIB,=X'0B230000'                                    EM029700
         B     FET016                                                   EM029710
*                                                                       EM029720
*                                                                       EM029730
*  SUBROUTINE TO GET A SECTOR - EXIT WITH R11 POINTING TO SECTOR        EM029740
*                                                                       EM029750
FETGET   ST    3,FETSVR3                                                EM029760
         LH    2,FETCYL                                                 EM029770
         LA    2,1(,2)                                                  EM029780
         LR    3,2                                                      EM029790
         SLL   2,4                                                      EM029800
         SLL   3,2                                                      EM029810
         AR    2,3                                                      EM029820
         LH    3,FETHEAD                                                EM029830
         LA    3,1(,3)                                                  EM029840
         AR    2,3                                                      EM029850
         AR    2,3                                                      EM029860
         S     2,=F'20'                                                 EM029870
         CLI   FETREC+1,X'04'                                           EM029880
         BH    FETGET01                                                 EM029890
         BCTR  2,0                                                      EM029900
FETGET01 CH    2,FETSRB                                                 EM029910
         BE    FETGET02                                                 EM029920
         STH   2,FETSRB                                                 EM029930
         ST    10,FETSVR10                                              EM029940
         L     1,=A(FETADDRS)                                           EM029950
         L     10,4(,1)                                                 EM029960
         MVC   SATSRB,FETSRB                                            EM029970
         MVC   SATIOA,FETBUFAD+1                                        EM029980
         LA    0,SATPCA                                                 EM029990
         LR    1,10                                                     EM030000
         DO    &CCC                                                     EM030010
         TM    XIOSWT,X'40'   ***** 8411 ONLY *****                     EM030020
         BZ    FETGET1B       ***** 8411 ONLY *****                     EM030030
         CLC   SATSRB,=H'80'  ***** 8411 ONLY *****                     EM030040
         BH    FETGET1A       ***** 8411 ONLY *****                     EM030050
         MVC   E2$RAHIB,=X'0B230000'                                    EM030060
         B     FET016                                                   EM030070
*                             ***** 8411 ONLY *****                     EM030080
FETGET1A LH    15,SATSRB      ***** 8411 ONLY *****                     EM030090
         SH    15,=H'80'      ***** 8411 ONLY *****                     EM030100
         STH   15,SATSRB      ***** 8411 ONLY *****                     EM030110
FETGET1B DS    0H             ***** 8411 ONLY *****                     EM030120
         ENDO                                                           EM030130
******** GET?  START                                                    EM030140
         GET?  (1),(0)                                                  EM030150
******** GET?  END                                                      EM030160
         TM    SATWAIT,X'80'                                            EM030170
         BZ    *-4                                                      EM030180
         LR    1,10                                                     EM030190
******** WAITF? START                                                   EM030200
         WAITF? (1)                                                     EM030210
******** WAITF? END                                                     EM030220
         L     10,FETSVR10                                              EM030230
FETGET02 L     11,FETBUFAD                                              EM030240
         LH    15,FETREC                                                EM030250
         CLI   FETREC+1,X'05'                                           EM030260
         BL    FETGET03                                                 EM030270
         S     15,=F'5'                                                 EM030280
FETGET03 LA    15,1(,15)                                                EM030290
FETGET04 BCT   15,FETGET05                                              EM030300
         L     3,FETSVR3                                                EM030310
         BR    5                                                        EM030320
*                                                                       EM030330
FETGET05 LA    11,270(,11)                                              EM030340
         B     FETGET04                                                 EM030350
*                                                                       EM030360
*                                                                       EM030370
FETBUFAD DC    F'0'                                                     EM030380
FETSVR3  DC    F'0'                                                     EM030390
FETSVR10 DC    F'0'                                                     EM030400
FETSRB   DC    H'0'                                                     EM030410
*                                                                       EM030420
         DS    0H                                                       EM030430
FETCHR   DS    0CL6                                                     EM030440
FETCYL   DC    H'0'                                                     EM030450
FETHEAD  DC    H'0'                                                     EM030460
FETREC   DC    H'0'                                                     EM030470
*                                                                       EM030480
         DS    0H                                                       EM030490
FETSAVE  DC    CL10' '                                                  EM030500
*                                                                       EM030510
FETCOMP  DC    CL8' '                                                   EM030520
*                                                                       EM030530
         ENDO                                                           EM030540
*                                                                       EM030550
         LTORAR                                                         EM030560
*                                                                       EM030570
EOJFTEND EQU   *                                                        EM030580
*                                                                       EM030590
         DROP  12                                                       EM030600
*                                                                       EM030610
         TITLE '360/20 DISC/TAPE EMULATOR - CSECT 27 - &NNN'            EM030620
*                                                                       EM030630
*                        DISC MOUNT                                     EM030640
*                                                                       EM030650
*                                                                       EM030660
*                                                                       EM030670
*        THIS CSECT WILL OVERLAY OVAREA - CSECT 23                      EM030680
*                                                                       EM030690
*                                                                       EM030700
&W       SET   '&NNN'.'27'                                              EM030710
&W       CSCTAR                                                         EM030720
*                                                                       EM030730
*                                                                       EM030740
         USING MOUNT,12                                                 EM030750
*                                                                       EM030760
*                                                                       EM030770
         DO    &D=0                                                     EM030780
MOUNT    LA    0,609               X'261' COMPLETION CODE - DISK MOUNT  EM030790
         ORG   *-2                                                      EM030800
         DC    XL2'0561'                                                EM030810
         L     15,=A(DSKTPERR)       WITH NO DSIK                       EM030820
         BR    15                  GO CLOSE AND DUMP                    EM030830
*                                                                       EM030840
*                                                                       EM030850
         ENDO                                                           EM030860
         DO    &D>0                                                     EM030870
MOUNT    DS    0H                                                       EM030880
         L     4,=A(BUFFER01)                                           EM030890
         DO    &CCC                                                     EM030900
         L     4,BCBNBA       ***** 8411 ONLY *****                     EM030910
         ENDO                                                           EM030920
         LA    11,BCBBUFR                                               EM030930
         ST    11,MNTWRK3                                               EM030940
         L     7,=A(XIO1)                                               EM030950
         TM    E2$RASWB,X'01'           BRANCH IF OPENS MUST BE         EM030960
         BO    MNT005                     PERFORMED FOR INLINE MOUNTS   EM030970
         ST    R5,MNTR5                 SAVE REGISTER 5                 EM030980
         TM    E2$RASWB,X'08'           BRANCH IF MOUNT REQUEST WAS     EM030990
         BO    MOUNT05                    FROM A CONTROL CARD           EM031000
         LA    R5,E2$RAKAR              R5 = ADDRESS OF SECONDRY        EM031010
         B     MNT001                     KEYIN AREA IN ADDRESS TABLE   EM031020
MOUNT05  LA    R5,E2$MNTPU-13           R5 = ADDRESS OF MOUNT PARAMS    EM031030
MNT001   CLI   XIOUNIT,X'00'                                            EM031040
         BE    MNT001A             ERROR - UNIT NOT FOUND               EM031050
         CLC   XIODRV,13(R5)            COMPARE THE DRIVE NUMBERS       EM031060
         BE    MNT002              POINT R7 TO XIO TABLE                EM031070
         LA    7,28(,7)                                                 EM031080
         B     MNT001                                                   EM031090
*                                                                       EM031100
MNT001A  MVC   E2$RAPCN(4),=X'5B00FE40'      INVALID 1ST OPERAND        EM031110
         B     MNT001C                                                  EM031120
*                                                                       EM031130
MNT001B  MVC   E2$RAPCN(4),=X'5B00FF40'      INVALID 2ND OPERAND        EM031140
         NI    XIOSWT,X'3F'        SET MOUNTED BIT OFF                  EM031150
MNT001C  LA    1,E2$RAPCN                                               EM031160
******** WTLD  START                                                    EM031170
         WTLD  (1),60                                                   EM031180
******** WTLD  END                                                      EM031190
         OI    E2$RASWB,X'04'           SET NO COMPLETION MSG BIT       EM031200
         NI    E2$RASWB,X'FD'           RESET NO OPEN BIT               EM031210
         CLI   E2$RAPCN+2,X'FF'         COMPLETE THE OPENS IF           EM031220
         BE    MNT008                     THEY WERE STARTED             EM031230
         B     MNT004              GO RE-OPEN MOUNTED DRIVES            EM031240
*                                                                       EM031250
MNT002   CLC   16(2,R5),=C'DS'          IS THIS A MOUNT DISPLAY         EM031260
         BNE   MNT002C             NOT DISPLAY                          EM031270
         TM    XIOSWT,X'80'                                             EM031280
         BZ    MNT002A             NOT MOUNTED                          EM031290
         MVC   MNTMSG(4),=CL4'MNT '                                     EM031300
         MVC   MNTMSG+4(2),XIOMNT                                       EM031310
         B     MNT002B                                                  EM031320
*                                                                       EM031330
MNT002A  MVC   MNTMSG,=C'CLOSED'                                        EM031340
******** WTLD  START                                                    EM031350
MNT002B  WTLD  MNTMSG,6                                                 EM031360
******** WTLD  END                                                      EM031370
         B     MNT004              GO RE-OPEN MOUNTED DRIVES            EM031380
*                                                                       EM031390
MNT002C  CLC   16(2,R5),=C'CL'          IS THIS A MOUNT CLOSE           EM031400
         BNE   MNT002D             NOT CLOSE REQUEST                    EM031410
         NI    XIOSWT,X'3F'        SET MOUNTED BIT OFF                  EM031420
         B     MNT004              GO RE-OPEN MOUNTED DRIVES            EM031430
*                                                                       EM031440
MNT002D  CLC   16(2,R5),=C'NX'          IS THIS A MOUNT NEXT            EM031450
         BNE   MNT003              GO USE MOUNT NO. FROM KEY-IN         EM031460
         TM    XIOSWT,X'80'                                             EM031470
         BZ    MNT001B             NX INVALID IF DRIVE NOT MOUNTED      EM031480
         PACK  MNTWRK2,XIOMNT                                           EM031490
         AP    MNTWRK2,=P'1'       STEP CURRENT NO. UP 1                EM031500
         UNPK  XIOMNT,MNTWRK2                                           EM031510
         OI    XIOMNT+1,X'F0'                                           EM031520
         B     MNT003A             GO MARK DRIVE MOUNTED AND RE-OPEN    EM031530
*                                                                       EM031540
MNT003   MVC   XIOMNT,16(R5)            MOVE MOUNT NUMBER TO XIO TABLE  EM031550
MNT003A  OI    XIOSWT,X'80'        MARK DRIVE MOUNTED                   EM031560
MNT004   L     7,=A(XIO1)          RE-OPEN ALL MOUNTED DRIVES           EM031570
MNT005   CLI   0(7),X'00'                                               EM031580
         BE    MNT009              END OF XIO TBL                       EM031590
         L     10,XIOSAT                                                EM031600
         MVC   SATIOA,MNTWRK3+1                                         EM031610
         TM    XIOSWT,X'80'                                             EM031620
         BZ    MNT008              DRIVE NOT MOUNTED                    EM031630
         L     1,E2$RACSP                                               EM031640
******** SETCS START                                                    EM031650
         SETCS (1),R                                                    EM031660
******** SETCS END                                                      EM031670
MNT006   LA    1,GETCSIOA                                               EM031680
******** GETCS START                                                    EM031690
         GETCS (1)                                                      EM031700
******** GETCS END                                                      EM031710
         CLI   GETCSID,C'4'                                             EM031720
         BE    MNT006              IGNORE TYPE 4 CARD                   EM031730
         CLI   GETCSID,C'3'                                             EM031740
         BE    MNT006              IGNORE TYPE 3 CARD                   EM031750
         CLI   GETCSID,C'2'                                             EM031760
         BE    MNT006B                                                  EM031770
         NI    XIOSWT,X'7F'             RESET THE MOUNTED BIT           EM031780
         B     MNT001B                                                  EM031790
MNT006B  CLC   DGCSDRV,XIODRV                                           EM031800
         BNE   MNT006              NOT THIS DRIVE                       EM031810
         CLC   DGCSMNT,XIOMNT                                           EM031820
         BNE   MNT006              NOT THIS MNT                         EM031830
         TM    E2$RASWB,X'02'           DELAY THE OPEN IF THIS IS AN    EM031840
         BO    MNT008                     INLINE MOUNT                  EM031850
         MVC   SATLFD+5(3),DGCSDVC                                      EM031860
         MVC   FCBLFD,SATLFD                                            EM031870
         MVC   FCBLNG,=H'256'                                           EM031880
         TM    SATOFLG,X'80'            DO NOT OPEN FILES               EM031890
         BO    MNT008                     IF ALREADY OPENED             EM031900
         LR    1,11                                                     EM031910
******** RDFCB START                                                    EM031920
         RDFCB (1)                                                      EM031930
******** RDFCB END                                                      EM031940
         MVC   FCBDSN1,DGCSDSN1                                         EM031950
         MVC   FCBDSN2,DGCSDSN2                                         EM031960
         MVC   FCBVSN,DGCSVOL                                           EM031970
         OI    SATFLG,X'04'                                             EM031980
         NI    SATSWT,X'AF'                                             EM031990
         MVI   SATLACE,X'00'                                            EM032000
         CLI   DGCSLACE,C' '                                            EM032010
         BE    MNT006A                                                  EM032020
         MVI   SATLACE,X'02'                                            EM032030
         OI    SATSWT,X'40'                                             EM032040
MNT006A  CLI   DGCSVER,C' '                                             EM032050
         BE    MNT007                                                   EM032060
         TM    E2$RAMOD,X'04'                                           EM032070
         BO    MNT007                                                   EM032080
         OI    SATSWT,X'10'                                             EM032090
MNT007   XC    SATMAX,SATMAX                                            EM032100
         MVC   SATEOD,=XL3'01'                                          EM032110
         OI    SATSWT,X'08'                                             EM032120
         LR    1,10                                                     EM032130
******** OPEN? START                                                    EM032140
         OPEN? (1)                                                      EM032150
******** OPEN? END                                                      EM032160
         TM    SATOFLG,X'80'                                            EM032170
         BO    MNT007A                                                  EM032180
         NI    XIOSWT,X'3F'                                             EM032190
         DO    &CCC                                                     EM032200
         B     MNT008                                                   EM032210
*                                                                       EM032220
         ENDO                                                           EM032230
MNT007A  DS    0H                                                       EM032240
         DO    &CCC                                                     EM032250
         LA    0,SATPCA       ***** 8411 ONLY *****                     EM032260
         LR    1,10           ***** 8411 ONLY *****                     EM032270
******** GET?  START                                                    EM032280
         GET?  (1),(0)        ***** 8411 ONLY *****                     EM032290
******** GET?  END                                                      EM032300
         TM    SATWAIT,X'80'  ***** 8411 ONLY *****                     EM032310
         BZ    *-4            ***** 8411 ONLY *****                     EM032320
         LR    1,10           ***** 8411 ONLY *****                     EM032330
******** WAITF? START                                                   EM032340
         WAITF? (1)           ***** 8411 ONLY *****                     EM032350
******** WAITF? END                                                     EM032360
         CLI   1361(11),C'C'  ***** 8411 ONLY *****                     EM032370
         BNE   MNT008         ***** 8411 ONLY *****                     EM032380
         OI    XIOSWT,X'40'   ***** 8411 ONLY *****                     EM032390
         ENDO                                                           EM032400
MNT008   LA    7,28(,7)            STEP TO NEXT XIO TBL ENTRY           EM032410
         B     MNT005                                                   EM032420
*                                                                       EM032430
MNT009   EQU   *                                                        EM032440
         L     1,E2$RACSR          RESET GETCS FILE                     EM032450
******** SETCS START                                                    EM032460
         SETCS (1),R                                                    EM032470
******** SETCS END                                                      EM032480
         LA    1,GETCSIOA                                               EM032490
******** GETCS START                                                    EM032500
         GETCS (1)                                                      EM032510
******** GETCS END                                                      EM032520
         TM    E2$RASWB,X'01'           RETURN TO CALLER IF THIS IS     EM032530
         BO    INLNMT1                    DELAYED OPEN FOR A MOUNT      EM032540
         MVC   MTMESG(4),MTCOMP         INSERT COMPLETED INDICATION     EM032550
         TM    E2$RASWB,X'04'           BRANCH IF MOUNT COMPLETED       EM032560
         BZ    MNT009Z                    MESSAGE IS NOT TO BE DISPLAYD EM032570
         MVC   MTMESG(4),MTATT          INSERT ATTEMPTED INDICATION     EM032580
MNT009Z  EQU   *                                                        EM032590
         MVC   MTMESG+4(1),13(R5)       SETUP AND PRINT THE MOUNT       EM032600
         MVC   MTMESG+5(2),16(R5)         COMPLETED MESSAGE WITH UNIT   EM032610
         MVC   MTMESG+7(6),DGCSVOL                                      EM032620
         MVC   MTMESG+13(1),DGCSDRV                                     EM032621
         MVI   MTMESG+14,X'08'                                          EM032622
         WTLD  MTMESG,25,MNT009Z          AND MOUNT NUMBER              EM032630
         L     R5,MNTR5                 RESTORE REGISTER 5              EM032640
         XC    E2$RAKAR,E2$RAKAR        IN-LINE MOUNT                   EM032650
         TM    E2$RASWB,X'08'          IN-LINE MOUNT                    EM032660
         BO    INLNMT                        YES - BRANCH               EM032670
         NI    E2$RASWB,X'FB'           RESET NO COMPLETED MSG BIT      EM032680
         EXIT  OC                                                       EM032690
INLNMT   EQU   *                                                        EM032700
*                                                                       EM032710
INLNMT1  DC    XL2'00'                  CAUSE PROGRAM CHECK             EM032720
*                                                                       EM032730
MNTMSG   DC    CL6' '                                                   EM032740
MNTWRK2  DC    XL2'00'                                                  EM032750
MNTWRK3  DC    F'0'                                                     EM032760
MNTR5    DC    F'0'                                                     EM032770
MTMESG   DC    XL41'00'                 MESSAGE AREA                    EM032780
MTATT    DC    X'5B079E61'              ATTEMPTED MOUNT MSG NUMBER      EM032790
MTCOMP   DC    X'5B077C61'              COMPLETED MOUNT MSG NUMBER      EM032800
*                                                                       EM032810
         ENDO                                                           EM032820
*                                                                       EM032830
         LTORAR                                                         EM032840
*                                                                       EM032850
         PTCHAR 20                                                      EM032860
*                                                                       EM032870
         DROP  12                                                       EM032880
*                                                                       EM032890
         TITLE '360/20 DISC/TAPE EMULATOR - CSECT 28 - &NNN'            EM032900
*                                                                       EM032910
*                        CLOSE ROUTINE                                  EM032920
*                                                                       EM032930
*                                                                       EM032940
*                                                                       EM032950
*        THIS CSECT WILL OVERLAY ODDBALL - CSECT 21                     EM032960
*                                                                       EM032970
*                                                                       EM032980
&W       SET   '&NNN'.'28'                                              EM032990
&W       CSCTAR                                                         EM033000
*                                                                       EM033010
*                                                                       EM033020
         USING CLOSEX,10                                                EM033030
*                                                                       EM033040
*                                                                       EM033050
CLOSEX   DC    H'8'                PHASE IDENT                          EM033060
*                                                                       EM033070
*  ENTRY BRANCH WILL BE TO CLOSEX+2                                     EM033080
*                                                                       EM033090
         DO    &D>0                                                     EM033100
*  ENTER WITH R9 EQUAL ZERO TO FREE BUFFERS BUT DONT CLOSE DISK FILES   EM033110
*                                                                       EM033120
         CLC   E2$RAPPS+5(3),E2$RA2EJ  EOJ ROUTINE/FETCH ROUTINE        EM033130
         BNE   IOGOX55                 NO BRANCH                        EM033140
         TM    E2$RAMOD,X'01'          MONITOR AREA STILL IN USE        EM033150
         BNO   IOGOX55                 NO BRANCH                        EM033160
         NI    E2$RAMOD,X'FC'          RESET XIO LEVEL MODE             EM033170
         NI    IOGOX01+1,X'0F'         RESET MONITOR IN USE SWITCH      EM033180
         LM    3,5,BUFSAVE+8                                            EM033190
         LTR   0,3                                                      EM033200
         BZ    IOGOX04A                EOJ/FETCH NOT RESIDENT           EM033210
         CR    3,6                                                      EM033220
         BNL   IOGOX04A                NOT RESIDENT IN MONITOR ARAEA    EM033230
         ST    3,BASE26                RESET EOJ/FETCH                  EM033240
         STM   4,5,PHASE3              LOAD ADDRESS AND                 EM033250
         MVI   PHASE,C'6'              ENTRANCE ADDRESS                 EM033260
         LA    1,PROG                  AND RELOAD PHASE                 EM033270
******** LOAD  START                                                    EM033280
         LOAD  (1),(0)                                                  EM033290
******** LOAD  END                                                      EM033300
IOGOX04A LM    4,5,BUFSAVE                                              EM033310
         ST    5,BCBNBA                RESET POINTER TO MONITOR AREA    EM033320
         LTR   5,5                                                      EM033330
         BZ    *+10                    THE POINTER WAS LAST BUFFER      EM033340
         XC    0(20,5),0(5)   CLEAR CONTROL INFO IN MONITOR BUFFER      EM033350
         L     4,=A(BUFFER01)             ADDRESS OF 1ST BUFF TO R4     EM033360
         MVC   4(4,4),SORTSAVE          RESTORE BCBNBA OF 1ST BUFFER    EM033370
IOGOX55  EQU   *                                                        EM033380
         ENDO                                                           EM033390
         DO    &T>0                                                     EM033400
         TM    TAPEECB+2,X'80'                                          EM033410
         BZ    *-4                 WAIT FOR TAPE TASK                   EM033420
         ENDO                                                           EM033430
         DO    &D=0                                                     EM033440
         BR    11                  EXIT                                 EM033450
         ENDO                                                           EM033460
         DO    &D>0                                                     EM033470
         TM    DISKECB+2,X'80'                                          EM033480
         BZ    *-4                 WAIT FOR DISK TASK                   EM033490
         L     4,=A(BUFFER01)                                           EM033500
         OI    FB003+1,X'80'                                            EM033510
CLS001   BAL   14,FREEBUFR                                              EM033520
         L     4,BCBNBA                                                 EM033530
         LTR   4,4                                                      EM033540
         BNZ   CLS001                                                   EM033550
         LTR   9,9                                                      EM033560
         BCR   8,11                EXIT IF R9 ZERO                      EM033570
         LR    5,11                RETURN ADDR INTO R5                  EM033580
         LR    9,10                BASE ADDR INTO R9                    EM033590
*                                                                       EM033600
         USING CLOSEX,9                                                 EM033610
         USING SAT,10                                                   EM033620
*                                                                       EM033630
         L     4,=A(BUFFER01)                                           EM033640
         LA    11,BCBBUFR                                               EM033650
         ST    11,CLSBUFR                                               EM033660
         L     7,=A(XIO1)                                               EM033670
CLS002   CLI   0(7),X'00'                                               EM033680
         BNE   CLS002B                                                  EM033690
CLS002A  BR    5                   NOP IF ERROR - ELSE EXIT             EM033700
         LA    0,611          X'263' COMPLETION CODE - NO GETCS CARD    EM033710
         ORG   *-2                                                      EM033720
         DC    XL2'0563'                                                EM033730
******** CANCEL START                                                   EM033740
         CANCEL (0)                                                     EM033750
******** CANCEL END                                                     EM033760
*                                                                       EM033770
*                                                                       EM033780
CLS002B  TM    XIOSWT,X'80'                                             EM033790
         BZ    CLS005              NOT MOUNTED                          EM033800
         L     10,XIOSAT                                                EM033810
         MVC   SATIOA,CLSBUFR+1                                         EM033820
         L     1,E2$RACSP                                               EM033830
******** SETCS START                                                    EM033840
         SETCS (1),R                                                    EM033850
******** SETCS END                                                      EM033860
CLS003   LA    1,GETCSIOA                                               EM033870
******** GETCS START                                                    EM033880
         GETCS (1)                                                      EM033890
******** GETCS END                                                      EM033900
         CLI   GETCSID,C'4'                                             EM033910
         BE    CLS003              IGNORE TYPE 4 CARD                   EM033920
         CLI   GETCSID,C'3'                                             EM033930
         BE    CLS003              IGNORE TYPE 3 CARD                   EM033940
         CLI   GETCSID,C'2'                                             EM033950
         BE    CLS004                                                   EM033960
         NI    CLS002A+1,X'0F'     MISSING GETCS CARD - SET ERROR SWT   EM033970
         B     CLS005                                                   EM033980
*                                                                       EM033990
CLS004   CLC   DGCSDRV,XIODRV                                           EM034000
         BNE   CLS003              NOT THIS DRIVE                       EM034010
         CLC   DGCSMNT,XIOMNT                                           EM034020
         BNE   CLS003              NOT THIS MNT                         EM034030
         CLI   SATEFLG,X'00'       DONT TRY TO CLOSE IF SAT ERROR -     EM034040
         BNE   CLS005                GO STEP TO NEXT XIO TBL ENTRY      EM034050
         MVC   FCBLFD,SATLFD                                            EM034060
         MVC   FCBLNG,=H'256'                                           EM034070
         TM    SATOFLG,X'80'            DO NOT CLOSE                    EM034080
         BZ    CLS005                     IF NOT OPENED                 EM034090
         LR    1,11                                                     EM034100
******** RDFCB START                                                    EM034110
         RDFCB (1)                                                      EM034120
******** RDFCB END                                                      EM034130
         MVC   FCBDSN1,DGCSDSN1                                         EM034140
         MVC   FCBDSN2,DGCSDSN2                                         EM034150
         MVC   FCBVSN,DGCSVOL                                           EM034160
         OI    SATFLG,X'04'                                             EM034170
         LR    1,10                                                     EM034180
******** CLOSE? START                                                   EM034190
         CLOSE? (1)                                                     EM034200
******** CLOSE? END                                                     EM034210
CLS005   LA    7,28(,7)            STEP TO NEXT XIO TBL ENTRY           EM034220
         B     CLS002                                                   EM034230
*                                                                       EM034240
CLSBUFR  DC    F'0'                                                     EM034250
         ENDO                                                           EM034260
*                                                                       EM034270
         LTORAR                                                         EM034280
*                                                                       EM034290
         DO    &D=0                                                     EM034300
         USING SAT,10                                                   EM034310
         ENDO                                                           EM034320
         DO    &D>0                                                     EM034330
         USING CCB,9                                                    EM034340
         ENDO                                                           EM034350
*                                                                       EM034360
         TITLE '360/20 DISC/TAPE EMULATOR - CSECT 29 - &NNN'            EM034370
*                                                                       EM034380
*                        NEW MONITOR INITIALIZATION                     EM034390
*                                                                       EM034400
*                                                                       EM034410
*                                                                       EM034420
         DO    &D>0                                                     EM034430
*  THIS CSECT WILL BE LOADED INTO THE 360/20 MONITOR AREA AT THE        EM034440
*    LOCATION SPECIFIED BY THE NEW INTERRUPT PSW.  THE FIRST 64 BYTES   EM034450
*    WILL BE THE NEW INTERRUPT ROUTINE.  THE REMAINDER OF THE CSECT IS  EM034460
*    THE RELOCATION ROUTINE.                                            EM034470
*                                                                       EM034480
*                                                                       EM034490
         ENDO                                                           EM034500
&W       SET   '&NNN'.'29'                                              EM034510
&W       CSCTAR                                                         EM034520
*                                                                       EM034530
*                                                                       EM034540
         DO    &D=0                                                     EM034550
         DC    2F'0'     PHASE NOT USED IF NO DISK - GEN FOR LINK EDIT  EM034560
         ENDO                                                           EM034570
         DO    &D>0                                                     EM034580
         USING INTRTN,2                                                 EM034590
*                                                                       EM034600
*                                                                       EM034610
INTRTN   DS    0H                                                       EM034620
STH      DC    X'40F00040'                                              EM034630
         DC    X'40E00042'                                              EM034640
         DC    X'40D00044'                                              EM034650
         DC    X'40C00046'                                              EM034660
         DC    X'40B00048'                                              EM034670
         DC    X'4090004A'                                              EM034680
         DC    X'1BEE'                                                  EM034690
         DC    X'4AE000AC'                                              EM034700
BZ       DC    X'47800024'                                              EM034710
         DC    X'0DEE'                                                  EM034720
LH       DC    X'48F00040'                                              EM034730
         DC    X'48E00042'                                              EM034740
         DC    X'48D00044'                                              EM034750
         DC    X'48C00046'                                              EM034760
         DC    X'48B00048'                                              EM034770
         DC    X'4890004A'                                              EM034780
         DC    X'81000090'                                              EM034790
*                                                                       EM034800
*                                                                       EM034810
**  THE FOLLOWING CODING IS ENTERED VIA BAL 14,64(,2)                   EM034820
*                                                                       EM034830
*                                                                       EM034840
         LA    3,STH+2                                                  EM034850
         LA    3,STH+2                                                  EM034860
         LA    4,LH+2                                                   EM034870
         LA    1,6                                                      EM034880
RELOC    LH    0,0(,3)                                                  EM034890
         AR    0,2                                                      EM034900
         STH   0,0(,3)                                                  EM034910
         STH   0,0(,4)                                                  EM034920
         LA    3,4(,3)                                                  EM034930
         LA    4,4(,4)                                                  EM034940
         BCT   1,RELOC                                                  EM034950
         LH    0,BZ+2                                                   EM034960
         AR    0,2                                                      EM034970
         STH   0,BZ+2                                                   EM034980
         BR    14                                                       EM034990
*                                                                       EM035000
         LTORAR                                                         EM035010
*                                                                       EM035020
         DROP  2                                                        EM035030
         ENDO                                                           EM035040
*                                                                       EM035050
         TITLE '360/20 DISC/TAPE EMULATOR - COMM REG DSECT - &NNN'      EM035060
*                                                                       EM035070
*                        360/20 COMMUNICATIONS REGION                   EM035080
*                                                                       EM035090
*                                                                       EM035100
*                                                                       EM035110
PCR      DSCTAR                                                         EM035120
         DS    CL9                                                      EM035130
PGMCONFG DS    C                                                        EM035140
PGMEMON  DS    CL2                                                      EM035150
         DS    CL12                                                     EM035160
PGMPGMID DS    0CL7                                                     EM035170
PGMNAME  DS    CL6                                                      EM035180
PGMSUBPH DS    C                                                        EM035190
         DS    CL3                                                      EM035200
PGMVERMD DS    CL2                                                      EM035210
         DS    C                                                        EM035220
PGMCB1   DS    C                                                        EM035230
PGMCB2   DS    C                                                        EM035240
PGMCB3   DS    C                                                        EM035250
         TITLE '360/20 DISC/TAPE EMULATOR - BUFF CONT DSECT - &NNN'     EM035260
*                                                                       EM035270
*                        EMULATOR BUFFER CONTROL BLOCK                  EM035280
*                                                                       EM035290
*                                                                       EM035300
*                                                                       EM035310
BCB      DSCTAR                                                         EM035320
BCBUSRB  DS    0CL3                                                     EM035330
BCBUNIT  DS    C         360/20 UNIT - HEX 01-04 - ZERO IF BUFFER FREE  EM035340
BCBSRB   DS    CL2       SAT RELATIVE BLOCK                             EM035350
BCBSWT1  DS    C         BIT SWITCHES SET ON AS FOLLOWS -               EM035360
*                   BIT 0 - UNASSIGNED                                  EM035370
*                   BIT 1 - SET ON WHEN BUFFER ASSIGNED TO UNIT         EM035380
*                         - SET OFF IF SCAN ISSUED FOR ANY SECTOR       EM035390
*                   BITS 2 THRU 7 - UNASSIGNED                          EM035400
BCBNBA   DS    F         NEXT BUFFER ADDR - ZERO IF LAST BUFFER         EM035410
BCBSAT   DS    F         SAT ADDR                                       EM035420
BCBRECAD DS    F         CURRENT RECORD ADDR                            EM035430
BCBUSE   DS    H         USE COUNTER                                    EM035440
BCBSWT2  DS    C         BIT SWITCHES SET ON AS FOLLOWS -               EM035450
*                   BIT 0 - IF WRITE ISSUED FOR ANY SECTOR              EM035460
*                   BITS 1 THRU 7 - UNASSIGNED                          EM035470
BCBSWT3  DS    C         BIT SWITCHES SET ON AS FOLLOWS -               EM035480
*                   BIT 0 - IGNORED                                     EM035490
*                   BIT 1 - 8411                                        EM035500
*                   BITS 2 THRU 7 - IGNORED                             EM035510
*                                                                       EM035520
BCBBUFR  DS    CL1536    ACTUAL BUFFER                                  EM035530
*                                                                       EM035540
*                                                                       EM035550
*                   TOTAL BUFFER CONTROL BLOCK LENGTH IS 1556 BYTES     EM035560
*                                                                       EM035570
         TITLE '360/20 DISC/TAPE EMULATOR - CCW DSECT - &NNN'           EM035580
*                                                                       EM035590
*                        360/20 CHANNEL COMMAND WORD                    EM035600
*                                                                       EM035610
*                                                                       EM035620
*                                                                       EM035630
CCW      DSCTAR                                                         EM035640
CCWCC    DS    C         COMMAND CODE                                   EM035650
CCWCFLG  DS    0C        CHAIN FLAG - HIGH ORDER BIT                    EM035660
CCWSECTR DS    C         SECTOR COUNT                                   EM035670
CCWDATA  DS    CL2       360/20 DATA ADDR                               EM035680
CCWCOUNT DS    CL2       360/20 COUNT FIELD ADDR IF DISK - BYTE COUNT   EM035690
*                                                           IF TAPE     EM035700
*                                                                       EM035710
         DO    &SSS=1                                                   EM035720
         TITLE '360/20 DISC/TAPE EMULATOR - ADD TAB DSECT - &NNN'       EM035730
*                                                                       EM035740
*                        ADDRESS TABLE                                  EM035750
*                                                                       EM035760
*                                                                       EM035770
*                                                                       EM035780
******** E2$RAD START                                                   EM035790
         E2$RAD                                                         EM035800
******** E2$RAD END                                                     EM035810
         ENDO                                                           EM035820
         TITLE '360/20 DISC/TAPE EMULATOR - XIO TAB DSECT - &NNN'       EM035830
*                                                                       EM035840
*                        DISC/TAPE XIO TABLE                            EM035850
*                                                                       EM035860
*                                                                       EM035870
*                                                                       EM035880
XIO      DSCTAR                                                         EM035890
XIOUSRB  DS    0CL3                                                     EM035900
XIOUNIT  DS    C         360/20 UNIT - HEX 01-04                        EM035910
XIOSRB   DS    CL2       SAT RELATIVE BLOCK                             EM035920
XIOCC    DS    C         LAST OR CURRENT COMMAND CODE OTHER THAN SENSE  EM035930
XIOSAT   DS    F         SAT ADDR                                       EM035940
XIODATCT DS    0CL8                                                     EM035950
XIODATA  DS    F         UPDATED DATA FIELD ADDR                        EM035960
XIOCOUNT DS    F         UPDATED COUNT FIELD ADDR                       EM035970
XIODRV   DS    C         360/20 DRIVE - CHAR 1-4                        EM035980
XIOMNT   DS    CL2       MOUNT NUMBER                                   EM035990
XIOSWT   DS    C         BIT 0 ON IF MOUNTED - BIT 1 ON IF 8411         EM036000
XIOICCYL DS    C         INITIAL COUNT FIELD CYLINDER                   EM036010
XIOICTR  DS    0CL2                                                     EM036020
XIOICTRK DS    C         INITIAL COUNT FIELD TRACK (HEAD)               EM036030
XIOICREC DS    C         INITIAL COUNT FIELD RECORD (SECTOR)            EM036040
XIOUCTR  DS    0CL2                                                     EM036050
XIOUCTRK DS    C         UPDATED COUNT FIELD TRACK (HEAD)               EM036060
XIOUCREC DS    C         UPDATED COUNT FIELD RECORD (SECTOR)            EM036070
XIOSECTR DS    C         UPDATED SECTOR COUNT - BINARY                  EM036080
XIOSTATS DS    0CL2                                                     EM036090
XIOUSTAT DS    C         UNIT STATUS BYTE                               EM036100
XIOSSTAT DS    C         SENSE STATUS BYTE                              EM036110
*                                                                       EM036120
*                                                                       EM036130
*                   TOTAL XIO TABLE LENGTH IS 28 BYTES                  EM036140
*                                                                       EM036150
         TITLE '360/20 DISC/TAPE EMULATOR - PLDA DSECT - &NNN'          EM036160
*                                                                       EM036170
*                        360/20 PLDA                                    EM036180
*                                                                       EM036190
*                                                                       EM036200
*                                                                       EM036210
PGM      DSCTAR                                                         EM036220
PGMZERO  DS    C                                                        EM036230
         DS    CL149                                                    EM036240
PGMINTRT DS    CL2       150 - INTERRUPT RTN ADDR                       EM036250
         DS    CL4                                                      EM036260
PGMUNIT  DS    C         156 - ERROR UNIT                               EM036270
         DS    CL3                                                      EM036280
PGMCCWAD DS    CL2       160 - ADDR OF ERROR CCW                        EM036290
         DS    CL6                                                      EM036300
PGMIOREQ DS    CL4       168 - BRANCH TO I/O REQUEST                    EM036310
PGMCDINT DS    CL2       172 - CARD INTERRUPT ADDR                      EM036320
         DS    CL6                                                      EM036330
PGMSLUB  DS    CL2       180 - ADDR OF START OF LUB TABLE               EM036340
         DS    CL2                                                      EM036350
PGMSPUB  DS    CL2       184 - ADDR OF START OF PUB TABLE               EM036360
PGMEPUB  DS    CL2       186 - ADDR OF END OF PUB TABLE                 EM036370
         DS    CL4                                                      EM036380
PGMCR    DS    CL2       192 - ADDR OF COMMUNICATIONS REGION            EM036390
PGMEOJ   DS    CL4       194 - BRANCH TO EOJ                            EM036400
PGMFETCH DS    CL4       198 - BRANCH TO FETCH                          EM036410
         DS    CL6                                                      EM036420
PGMEMMR  DS    CL2       208 - ADDR OF END OF MON MOVE RTN              EM036430
         DS    CL12                                                     EM036440
PGMEMIOA DS    CL2       222 - ADDR OF END OF MON I/O AREA              EM036450
PGMETER  DS    CL2       224 - ADDR OF END OF TAPE ERR RTN              EM036460
PGMSMIOA DS    CL2       226 - ADDR OF START OF MON I/O AREA            EM036470
PGMETS   DS    CL2       228 - ADDR OF END OF TAPE STATISTICS           EM036480
         DS    CL20                                                     EM036490
PGMMSTAT DS    CL2       250 - MONITOR STATUS                           EM036500
*                                                                       EM036510
         TITLE '360/20 DISC/TAPE EMULATOR - CCB DSECT - &NNN'           EM036520
*                                                                       EM036530
*                        360/20 COMMAND CONTROL BLOCK                   EM036540
*                                                                       EM036550
*                                                                       EM036560
*                                                                       EM036570
CCB      DSCTAR                                                         EM036580
CCBTRBC  DS    0CL2      TAPE RESIDUAL BYTE COUNT                       EM036590
CCBDSB   DS    C         DISK SENSE BYTE                                EM036600
CCBDRSC  DS    C         DISK RESIDUAL SECTOR COUNT                     EM036610
CCBUSTAT DS    C         UNIT STATUS BYTE                               EM036620
CCBCOM   DS    C         COMMUNICATIONS BYTE                            EM036630
CCBUNIT  DS    0CL2      UNIT ADDR IF NON-STANDARD I/O                  EM036640
CCBBYTE4 DS    C         ZERO OR CCW DISPLACEMENT IF DISK ERROR         EM036650
CCBLUB   DS    C         LUB DISPLACEMENT                               EM036660
CCBCCW   DS    CL2       360/20 ADDR OF 1ST CCW                         EM036670
*                                                                       EM036680
         TITLE '360/20 DISC/TAPE EMULATOR - SAT DSECT - &NNN'           EM036690
*                                                                       EM036700
*                        90/30 SAT DTF                                  EM036710
*                                                                       EM036720
*                                                                       EM036730
*                                                                       EM036740
SAT      DSCTAR                                                         EM036750
         DS    CL2                                                      EM036760
SATWAIT  DS    C         TRANSMISSION BYTE                              EM036770
         DS    CL25                                                     EM036780
SATLFD   DS    CL8       LFD NAME                                       EM036790
SATOFLG  DS    C         BIT 0 WILL BE ON IF OPENED                     EM036800
SATFLG   DS    C         SET BIT 5 ON TO INDICATE FCB IN CORE FOR OPEN  EM036810
         DS    CL18                                                     EM036820
SATEFLG  DS    C                                                        EM036830
         DS    CL103                                                    EM036840
*                                                                       EM036850
*                   REMAINDER OF DSECT IS FOR PCA                       EM036860
*                                                                       EM036870
SATPCA   DS    0CL36                                                    EM036880
         DS    CL2                                                      EM036890
SATSRB   DS    CL2       SAT RELATIVE BLOCK                             EM036900
SATMAX   DS    CL8       MAX REL BLK AND RECS PER TRK                   EM036910
         DS    C                                                        EM036920
SATEOD   DS    CL3       EOD REL BLK                                    EM036930
         DS    C                                                        EM036940
SATIOA   DS    CL3       I/O AREA ADDR                                  EM036950
         DS    CL5                                                      EM036960
SATLACE  DS    C         LACE FACTOR  -  0 OR 2                         EM036970
         DS    CL6                                                      EM036980
SATSWT   DS    C         BIT 1 ON IF LACE  -  BIT 3 ON IF VERIFY        EM036990
         DS    CL3                                                      EM037000
*                                                                       EM037010
         TITLE '360/20 DISC/TAPE EMULATOR - FCB/GETCS DSECT - &NNN'     EM037020
*                                                                       EM037030
*                        90/30 FCB AND GETCS                            EM037040
*                                                                       EM037050
*                                                                       EM037060
*                                                                       EM037070
FCB      DSCTAR                                                         EM037080
FCBLFD   DS    CL8                                                      EM037090
FCBLNG   DS    CL2                                                      EM037100
         DS    CL20                                                     EM037110
FCBDSN2  DS    CL26                                                     EM037120
         DS    CL20                                                     EM037130
FCBDSN1  DS    CL18                                                     EM037140
         DS    CL24                                                     EM037150
FCBVSN   DS    CL6                                                      EM037160
         DS    CL132                                                    EM037170
*                                                                       EM037180
*                   REMAINDER OF DSECT IS FOR GETCS I/P AREA            EM037190
*                                                                       EM037200
GETCSIOA DS    0CL80                                                    EM037210
DGCSDVC  DS    CL3                                                      EM037220
DGCSMNT  DS    CL2                                                      EM037230
DGCSVOL  DS    CL6                                                      EM037240
         DS    CL2                                                      EM037250
DGCSDRV  DS    C                                                        EM037260
         DS    CL2                                                      EM037270
DGCSRES  DS    C                                                        EM037280
         DS    CL3                                                      EM037290
DGCSVER  DS    C                                                        EM037300
         DS    CL2                                                      EM037310
DGCSLACE DS    C                                                        EM037320
DGCSDSN1 DS    CL18                                                     EM037330
DGCSDSN2 DS    CL26                                                     EM037340
*                                                                       EM037350
         ORG   DGCSDVC                                                  EM037360
         DS    CL5                                                      EM037370
TGCSDRV  DS    C                                                        EM037380
         DS    C                                                        EM037390
TGCSMOD  DS    C                                                        EM037400
         DS    CL3                                                      EM037410
TGCSRES  DS    C                                                        EM037420
         DS    CL67                                                     EM037430
GETCSID  DS    C                                                        EM037440
*                                                                       EM037450
         TITLE '360/20 DISC/TAPE EMULATOR - ERROR CODES - &NNN'         EM037460
*                                                                       EM037470
*                        90/30 ERROR CODES PASSED TO DUMP               EM037480
*                                                                       EM037490
*                                                                       EM037500
*                                                                       EM037510
*        501   SAT ERROR ON 360/20 PHYSICAL DISC DRIVE 1                EM037520
*        502   SAT ERROR ON 360/20 PHYSICAL DISC DRIVE 2                EM037530
*        503   SAT ERROR ON 360/20 PHYSICAL DISC DRIVE 3                EM037540
*        504   SAT ERROR ON 360/20 PHYSICAL DISC DRIVE 4                EM037550
*        505   SAT ERROR ON 360/20 PHYSICAL DISC DRIVE 5                EM037560
*        506   SAT ERROR ON 360/20 PHYSICAL DISC DRIVE 6                EM037570
*        507   SAT ERROR ON 360/20 PHYSICAL DISC DRIVE 7                EM037580
*        508   SAT ERROR ON 360/20 PHYSICAL DISC DRIVE 8                EM037590
*        558   NO ADDITIONAL BUFFER FOR DISC FETCH OR 8411              EM037600
*        559   DISC FETCH WITH DISC=0                                   EM037610
*        560   DISC EOJ WITH DISC=0                                     EM037620
*        561   DISC MOUNT WITH DISC=0                                   EM037630
*        562   NO MOUNT 00 GETCS CARD FOR DISC SYSRES                   EM037640
*        563   NO GETCS CARD FOR CLOSE                                  EM037650
*        564   NO PUB FOR SYSRES                                        EM037660
*        565   PACK ON SYSRES DRIVE IS NOT A SYSRES                     EM037670
*        566   TAPE ON SYSRES DRIVE IS NOT A SYSRES                     EM037680
*        567   TPS MONITOR TAPE IS NOT 9-TRACK                          EM037690
*        268   SAT ERROR                                                EM037700
*        569   NO GETCS CARD FOR TAPE SYSRES                            EM037710
*        599   // VFB STATEMENT MISSING IN PRINTER JOB CONTROL          EM037720
*                                                                       EM037730
*                                                                       EM037740
*                                                                       EM037750
*                                                                       EM037760
.X$999   LABEL                                                          EM037770
         END                                                            EM037780
