         TITLE 'SUPERVISOR'                                             10530001
SYSS00   START 0                                                        10530002
         USING *,0,4                                                    10530003
         ORG   SYSS00+5                                                 10530004
         DC    C' '                                                     10530005
         ORG   SYSS00+88                                                10530006
         DC    X'00040000'              NEW  EXT SIGNAL PSW             10530007
         DC    A(SYSEXT)                                                10530008
         DC    X'00040000'              NEW  SVC INTRT  PSW             10530009
         DC    A(SYSSVC)                                                10530010
         DC    X'00040000'              NEW  PROG CHECK PSW             10530011
         DC    A(SYSSPC)                                                10530012
         DC    X'00060000'              NEW  MACH CHECK PSW             10530013
SYSSMD         DC   X'F0FFFFFF'                                         10530014
         DC    X'00040000'              NEW  IO INTERPT PSW             10530015
         DC    A(SYSXIN)                                                10530016
         DC    YL2(SYSSCR)                                              10530017
         DC    YL2(SYSUTB)                                              10530018
       ORG   SYSS00+144                 DIAGNOSTICS USE 8 BYTES  START  10530019
SYSSLB     DC    X'FF0500000F'                                          10530020
         DC    AL3(SYSLDR)             USE ABSOLUTE LOADER              10530021
SYSS83   DS    D                       TO SAVE PSW BEFORE TIMER RTN     10530022
SYSS86   DS    D                                                        10530023
SYSS81   LM    10,11,SYSS86                                             10530024
         LPSW  SYSS83                  RETURN FROM TIMER RTN            10530025
SYSS84   DS    D                       TO SAVE PSW BEFORE OP.COM RTN    10530026
SYSS87   DS    D                                                        10530027
SYSS03   DC    X'09000000'              CCW WRITE MSG                   10530028
         DC    F'5'                                                     10530029
SYSS04   DC    X'0A000005'              CCW READ  REPLY                 10530030
         DC    F'1'                                                     10530031
SYSZVE   DS    F                       TO SAVE REG 10 FOR MSG HANDLING  10530032
SYSSAC   DS    F                       TO SAVE  REPLY ADDRESS           10530033
SYSSCB   DC    X'1000'                 DUMMY CCB FOR SVC 2 FORCE RTRN   10530034
SYSS93   MVC   24(8),32                                                 10530035
         B     SYSS13                                                   10530036
SYSTWA   DC    X'001F'                 TW ADDRESS                       10530037
SYSSVC   L     12,36                    LOAD ADD IN R12                 10530038
       CLI   35,X'01'       IS V SVC 1                                  10530039
         BL    SYSXCP                   GO TO IOCS (CODE 0)             10530040
         BE    SYSS11                   GO TO FETCH ROUTINE (CODE 1)    10530041
       CLI   35,X'03'       IS V SVC 3                                  10530042
         BNL   SYSS80                                                   10530043
SYSS06   MVC   0(5),0(12)               CODE 2    MESSAGE               10530044
         LA    12,6(12)                 CALCULATE NEXT INSTRUCTION ADDR 10530045
         IC    13,36                   STORE ADDRESS IN PSW             10530046
         ST    12,36                                                    10530047
         STC   13,36                                                    10530048
         BCTR  12,0                    CALCULATE EDDRESS FOR REPLY      10530049
         MVI   SYSS03+4,X'20'          SUPPRESS CHAINING IN CCW         10530050
         CLI   4,C'A'                   IF A  REPLY                     10530051
         BNE   *+8                      IS WANTED PUT CHAINING BIT      10530052
         MVI   SYSS03+4,X'60'                                           10530053
         ST    12,SYSSAC               SAVE ADDRESS FOR REPLY           10530054
         MVC   58(2),SYSTWA            LOAD CH,UNIT ADDRESS             10530055
       LA    12,SYSMSG-SYSQMX                                           10530056
       ST    10,SYSZVE                                                  10530057
         BAL   10,SYSQXS               USE ROUTINE TO SET UP CCW AND T5 10530058
         DC    YL2(SYSS03)             CCW ADDRESS                      10530059
       L     10,SYSZVE                                                  10530060
         TM    SYSSCB,X'20'                                             10530061
         BC    8,SYSS93                 NOT DISASTER,CONTINUE           10530062
SYSS09   OI    32,X'01'                 UNMASK EXT IN                   10530063
         OI    33,X'02'                 AND ENTER WAIT STATE            10530064
SYSXST LPSW  32                         RETURN TO MAIN LINE   SVC       10530065
SYSS82   LM    10,11,SYSS87                                             10530066
         NI    SYSSOC+1,X'0F'          ACCEPT NEXT ATTENTION ON 1052    10530067
         LPSW  SYSS84                  RETURN FROM OP.COM. RTN          10530068
SYSS80   CLI   35,X'04'                                                 10530069
         BE    SYSS82                  CODE 3  RETURN FROM OP.COM RTN   10530070
         BL    SYSS81                  CODE 3  RETURN FROM TIMER RTN    10530071
SYSS10   MVI   35,X'10'                 SVC CODE ERROR                  10530072
         MVC   40(8),32                 SIMULATE PROG CHECK             10530073
         B     SYSSPC                   WITH INTRT CODE 00010000        10530074
SYSS11   CLC   0(6,12),SYSSLC           COMPARE NAME WITH EOJ           10530075
SYSSAT   MVC   32(8),SYSSLB             MOVE  PROB PSW                  10530076
         BNE   SYSS09+8                 LOAD PSW                        10530077
         B     SYSS09+4                 LOAD PSW WITH WAIT STATE        10530078
SYSEXT   TM    27,X'80'                IS IT TIMER INTERRUPT            10530079
         BO    SYSSTM                  GO TO HANDLING OF TIMER INTERRUP 10530080
SYSS13   CLI   4,C'A'                   IF REPLY NOT REQUIRED           10530081
         MVI   4,C' '                                                   10530082
         BNE   SYSS15                   IGNORE THIS MSG                 10530083
         L     12,SYSSAC                                                10530084
         MVC   0(1,12),5                MOVE REPLY IN CALLING SEQUENCE  10530085
         CLI   5,C' '                                                   10530086
         BE    SYSS15                   IGNORE CODE IF BLANK            10530087
         NI    5,X'FC'                 IS CODE 0 TO 4 IN BINARY         10530088
         CLI   5,X'F0'                  OR CHARACTER FORM               10530089
         BE    SYSS17                                                   10530090
SYSS14   CLI   5,X'02'                  IF CODE 0 OR 1                  10530091
         BL    SYSS18                   GO TO ABNORMAL END OF JOB       10530092
         CLI   5,X'03'                                                  10530093
         BE    SYSS99                                                   10530094
         BL    SYSS19                   GO TO -SET 7TH BIT ON IN UPSI - 10530095
SYSS15   MVI   5,C' '                   IGNORE OR END OF MSG-REPLY      10530096
         NI    25,X'FD'                 PROCESSING                      10530097
SYSS16   LPSW  24                                                       10530098
SYSS99   NI    SYSUPS,X'FE'                                             10530099
         B     SYSS15                                                   10530100
SYSS17 MVC   5(1),0(12)                                                 10530101
         NI    5,X'0F'                           INTO BINARY FORM       10530102
         B     SYSS14                                                   10530103
SYSS19   OI    SYSUPS,X'01'            SET ON 8TH BIT OF UPSI           10530104
         B     SYSS15                                                   10530105
SYSS20   DC    H'1'                                                     10530106
SYSSTM   MVC   SYSS83(8),24            SAVE OLD PSW                     10530107
         STM   10,11,SYSS86                                             10530108
         LH    12,SYSRTA+2             IS AN USER(S RTN PROVIDED        10530109
         LTR   12,12                                                    10530110
         BZ    SYSS81                  NO - RETURN                      10530111
         STH   12,30                   YES - GO TO THIS ROUTINE         10530112
         LPSW  24                                                       10530113
SYSSOC   BC    0,SYSSCX                ACCEPT OR NOT ATTENTION ON 1052  10530114
         MVC   SYSS84(8),56            SAVE OLD PSW                     10530115
         STM   10,11,SYSS87                                             10530116
         SVC   2                       MACRO TO ASK FOR THE CODE        10530117
         DC    C'0902A '                                                10530118
         LH    12,SYSRTA+4             IS AN USER,S RTN PROVIDED        10530119
         LTR   12,12                                                    10530120
         BZ    SYSS82                  NO - RETURN                      10530121
         STH   12,62                   YES - GO TO THIS ROUTINE         10530122
         OI    SYSSOC+1,X'F0'          1052 ATTENTION NOT ACCEPTED      10530123
SYSSCX   LPSW  56                                                       10530124
         DS    0F                                                       10530125
SYSS21   DC    X'0000FFFF'              MASK FOR LOAD HALFWORD          10530126
SYSSCR   DC    F'0'                    COMMUNICATION REGION- MONTH-DAY  10530127
         DC    H'0'                                           YEAR      10530128
         DC    X'000000'                                      DATE      10530129
         DC    X'00'                                          CONFIG    10530130
SYSEND   DC    YL2(SYSSND)             END OF SUPERVISOR                10530131
SYSUSR   DC    2F'0'                   FOR USER - RESET BY SYSEOJ       10530132
         DC    3C'0'                             NOT RESET              10530133
SYSUPS   DC    X'00'                   UPSI                             10530134
SYSS26   DC    C'NAMEXX'                                                10530135
SYSRTA   DC    2FL4'0'                 PC-TIMER-OP.COM-1015 ROUTINES    10530136
         DC    X'0000'                 SYSEOJ SWITCHES                  10530137
SYSSPC   LH    13,SYSRTA                                                10530138
               CH   13,SYSS20                                           10530139
         BC    12,SYSSPD                                                10530140
               MVC  32(8),40                                            10530141
               STH  13,38                                               10530142
               LPSW 32                                                  10530143
SYSSPD         SVC  2                                                   10530144
         DC    C'0901  '               MESSAGE FOR PROG CHECK           10530145
SYSS18   CLR   13,13                    RESET COND CODE TO ZERO         10530146
         MVI   5,C' '                                                   10530147
         B     SYSS11+6                   AND BRANCH TO LOAD PROB PSW   10530148
SYSSLC   DC    C'SYSEOJ'                                                10530149
*                                                                       10530150
SYSUTB   DC    X'00000005'             SYSRES CONTAINS PUB LIMITS       10530151
       DC    X'00080801'                1402,UNIT 08,SYSRDR             10530152
       DC    X'00100602'                1403,UNIT 10,SYSLST             10530153
       DC    X'000A0403'                1442,UNIT 0A,SYSIPT             10530154
       DC    X'00040A04'                1402,UNIT 04,SYSOPT             10530155
SYSUTY DC    X'001F0200'                1052,UNIT 1F,SYSLOG             10530156
         DC    X'00000000'             SYS000                           10530157
         DC    X'00000000'             SYS001                           10530158
         DC    X'00000000'             SYS002                           10530159
         DC    X'00000000'             SYS003                           10530160
         DC    X'00000000'             SYS004                           10530161
*  *  *  TAPE BIASED SIMPLER SCHEDULER *  *  *                          10530162
SYSENS   EQU   SYSS00+24                HOLD C SENSE INFO               10530163
SYSHLD EQU   8           HOLDING AREA FOR TYPE MSG                      10530164
SYSUSE EQU   19                         BYTE SHOWS ACTIVITY ON CHANNLS  10530165
*            * * * REQUEST I/O ENTRY POINT * * *                        10530166
* * *  SPVR  LOADED REG 12  FOR ME                                      10530167
SYSXCP LH    13,0(12)                   LOAD CCB ADDRESS                10530168
* * *  NEED  AND ABOVE 32 K                                             10530169
       LA    12,2(12)                   ADD 2 TO GET RETURN ADDRESS     10530170
       STH   12,38                      STORE RETURN ADDRESS            10530171
       NC    0(5,13),SYSXZA             ZERO LINK AND COMMUNICATIONS    10530172
SYSQDE   TM    2(13),X'04'              SHOULD THIS CCB WAIT FOR DEV E  10530173
         BC    8,SYSAAA                 BYPASS STASH IN WAITING LIST    10530174
* * *    PUSH DOWN LIST OF DEVICES SIG AT DEV END                       10530175
       STH   13,SYSVCB                  STORE CCB ADDRESS               10530176
         MVC   SYSA01(SYSLNG),SYSA01+2       PUSH DOWN LIST             10530177
SYSAAA  EQU  *                                                          10530178
       STH   13,SYSVCB                  SAVE CCB ADDRESS                10530179
       LH    13,4(13)                    LOAD SYMBOLIC ADDRESS          10530180
       SR     12,12                     ZERO REGISTER                   10530181
       IC    12,SYSUTB(13)              PULL CHANNL                     10530182
       AR     12,12                     DOUBLE CHANNEL                  10530183
       OC    SYSUSE(1),SYSXCN-SYSS00(12) SET CHANNEL USE BYTE           10530184
*            * * * PLACE CCB AT END OF Q AND LINK * * *                 10530185
       LA    13,SYSQMX(12)              LOAD ADDRESS OF HEAD OF Q       10530186
SYSQLL CLI   0(13),X'00'                TEST CORE FOR BLANK ADRESS      10530187
       BC    8,SYSQLK                   END OF Q   SO PASS TO STORE CCB 10530188
       LH    13,0(13)                   PULL LINKAGE ADDRESS            10530189
     B       SYSQLL                                                     10530190
SYSQLK MVC   0(2,13),SYSVCB               PUT THIS CCB AT END OF Q      10530191
       CLI   SYSXPT-SYSS00(12),X'07'    EXPECT INTERRUPT THIS CHANNEL Q 10530192
       BNE   SYSXST                     EXIT SUPVR IF NOW EXPECT INTRPT 10530193
SYSQST MVC   56(8),32                                                   10530194
*            * * * START I/O FOR THIS Q      * * *                      10530195
SYSUA1 LH    13,SYSQMX-SYSS00(12)       PULL HEAD OF Q CCB ADDR         10530196
       MVC   74(2),6(13)                PULL CCW ADDR INTO CAW          10530197
       LH    13,4(13)                   LOAD SYMBOLIC ADDRESS           10530198
         CLI   SYSUTB-SYSS00+2(13),X'00'     IS THIS DEVICE A TAPE      10530199
         BNE   SYSWF1                   BRANCH IF NOT                   10530200
         NI    SETMOD,X'03'             SET MODE BITS OFF               10530201
         OC    SETMOD(1),SYSUTB-SYSS00+3(13)      SET MOD ON            10530202
         MVC   SYSTIC+2(2),74          PLACE CCW INTO TIC               10530203
         MVC   74(2),ADSTMD+2           PLACE SET MODE ADDR INTO CAW    10530204
SYSWF1   LH    13,SYSUTB(13)            PUT CHNL, DEVICE IN REGISTER    10530205
SYSWFH   B       SYSWIO            BYPASS WOIT                          10530206
       MVI   SYSWUP+1,X'F0'             TURN SWUP TO BRANCH             10530207
         MVI     SYSXWW+1,X'00'                                         10530208
         TIO     0(13)             CHECK CHANNEL END                    10530209
         BC      6,*-4             WAIT FOR DEVICE END                  10530210
*            * * * START I/O ROUTINE    * * *                           10530211
SYSWIO SIO   0(13)           START IO                                   10530212
       STH   13,58                      IF CSW STORED NEED CH/UN ADRES  10530213
       BC    7,*+8            BYPASS SET EX PECT                        10530214
       STH   13,SYSXPT-SYSS00(12)       MOVE CHNL,DEVICE TO 5XP53T 9N3  10530215
       BC    10,SYSXWW                  GET OUT IF CC IS 0,2            10530216
       BC    1,SYSXMN                   OVERFLO FOR NOT OPERATIONAL     10530217
         NI    SYSUIS+1,X'0F'           IMMEDIATE END                   10530218
       TM    68,X'10'                   DEVICE BUSY                     10530219
       BC    12,SYSXBB                  NO SO ERR OR IMMED END          10530220
       TM    68,X'04'                   DEVICE END                      10530221
       BC    1,SYSWIO                   TRY AGAIN D.E INT WAS PENDING   10530222
SYSXWW BC    15,SYSXIT                  BUSY BUT NO END SAYS TRY LATER  10530223
       TIO   0(13)                                                      10530224
       BC     2,*-4              WAIT FOR CHANNEL END                   10530225
       BC    15,SYSXBB                  END OF WAIT,CHECK ERRORS        10530226
*            * * * I/O INTERRUPT                                        10530227
SYSXIN SR     12,12                     ZERO REGISTER                   10530228
         OI    SYSUIS+1,X'F0'           I/O INTRPT  NOT INISL SELECTION 10530229
       IC    12,58                       INSERT CHANNEL                 10530230
       AR    12,12                      DOUBLE CHANNEL                  10530231
SYSXCK CLC   SYSXPT-SYSS00(2,12),58      EXPECT INTRUPT THIS CH,DEVICE  10530232
      BC  7,SYSXAT       TEST ATTENTION ETC                             10530233
* * *  ANALYSE FOR ERRORS, INTERRUPT OR CSW STORED                      10530234
SYSXBB LH    13,SYSQMX-SYSS00(12)       LOAD CCB ADDRESS FOR SET ERR FL 10530235
       TM    69,X'3F'                   TEST CHNNL,DATA,CONTROL,INTFACE 10530236
       BC    7,SYSQCC                   CHANNNEL ERRORS HARD STOP       10530237
SYSXCC TM    68,X'01'                   TEST UNIT EXCEPTION,END FILEETC 10530238
       BC    8,SYSXUC                   BR TO UNIT TEST UNIT CHECK      10530239
       OI    3(13),X'04'                TURN ON UNIT EXCEPTION          10530240
SYSXUC TM    68,X'02'                   UNIT CHECK                      10530241
       BC    7,SYSWUC                   YES,GO TO WORK UNIT CHECK       10530242
* * *  NO ERRORS ASSUME CHANNEL END                                     10530243
SYSUDE TM    68,X'04'                   DEVICE END                      10530244
       BC    8,SYSWUP                   NO LEAVE IT IN LITST            10530245
       OI    3(13),X'01'                SET END  DEV END BIT            10530246
SYSWUP BC    0,SYSQXC                   ER RTN CUT Q BY BRANCH HERE     10530247
       TM    69,X'80'                   PROG  CONTR INTR                10530248
       BC    8,SYSPST             NO CONTINUE                           10530249
         OI    4(13),X'80'              TURN PCI BIT ON                 10530250
         TM    69,X'08'                 CHANNEL END                     10530251
         BNE   SYSXIT                                                   10530252
SYSPST OC    2(1,13),69                 OR IN WLR,PCI  BITS             10530253
       OI    2(13),X'80'                POST TRAFFIC BIT                10530254
SYSUPD MVI   SYSXPT-SYSS00(12),X'07'    SAY CHNL NOT EXPECT INTERRUPT   10530255
       MVC   SYSQMX-SYSS00(2,12),0(13)  MOVE NEXT TO HEAD OF Q          10530256
       MVC   0(2,13),70                 PUT RESIDUAL COUNT IN CCB       10530257
SYSQTT CLI   SYSQMX-SYSS00(12),X'00'     IS Q EMPTY                     10530258
       BC    6,SYSUA1                   NO,TRY TO START I O             10530259
       NC    SYSUSE(1),SYSXCN+1-SYSS00(12) CLEAR BIT IN CHANNEL USE BY  10530260
SYSXIT LPSW  56                         RETURN VIA LOAD OLD PSW         10530261
SYSXRS XC    SYSQMX(8),SYSQMX           TURN Q A TO ZERO                10530262
       MVI   SYSXPT,X'07'               NOT EXXECT ON MPX CHANNEL       10530263
       MVC   SYSXPT+1(7),SYSXPT         NOT EXPECT ON ANY CHNNL         10530264
       MVI   SYSUSE,X'00'               SET CHANNEL ACTIVITY TO ZERO    10530265
SYSVRR MVI   SYSWUP+1,X'00'             NOP ERR I/O RETURN IF ERR CH OK 10530266
         MVI     SYSXWW+1,X'F0'         RESET BRANCH AFTER SIO          10530267
       MVI   SYSQXR+1,X'F0'             SET SWITCH TO BR AS NORMAL      10530268
       MVI   SYSWFH+1,X'F0'             SET SW TO BRANCH                10530269
       CLI   SYSWFF+1,X'00'  '             IS SWITCH TO BRANCH          10530270
       BCR   8,13                       NO, RETURN                      10530271
         LM    1,11,SYSVRX              RESTORE REGISTERS               10530272
       MVI   SYSWFF+1,X'00'             SWITCH TO SAVE PSW              10530273
       BCR   15,13                     RETURN                           10530274
*            * * * TEST UNIT CHECKS     * * *                           10530275
SYSWUC OI    2(13),X'20'                SET UNCORRECTABLE ERROR BIT CCB 10530276
       TM    2(13),X'01'                USER ERROR RTN                  10530277
       BC    1,SYSWUP                   YES,RETURN TO USER              10530278
SYSWFF BC    0,SYSXFF                   BYPASS SAVE PSW AND STATUS      10530279
SYSVRZ   STM   1,11,SYSVRX              SAVE REGISTERS FOR WORK         10530280
       LM    1,5,SYSAVE       SAVE CORE BY REG   BCR  * * *             10530281
       MVI   SYSQCT,X'0'                SERO ERROR COUNTER              10530282
SYSXFF OI    SYSWFF+1,X'F0'              TURN ON SWITCH TO BYPASS SAVE  10530283
         MVI     SYSWFH+1,X'00'    NOP  SWITCH                          10530284
       LH   11,66                       NEXT CCW     INTO REG           10530285
         SH   11,SYSC08                SUBTRACT 8 TO GET LAST CCW       10530286
       STH  11,66         SAVE NEW CCW IN CORE                          10530287
       MVC   SYSVCW(12),64               SAVE CSW,   CAW                10530288
       MVI     50,X'1F'                 1F  FOR UNIT CHECK              10530289
       XC    SYSENS(6),SYSENS           SET SENSE TO ZERO               10530290
       LH    9,58                                                       10530291
       MVC   74(2),SYSXSC                SENSE CCW                      10530292
       SIO   0(9)                       SENSE                           10530293
         BC    6,*-4                                                    10530294
* * * *      ASSUMED  NO ERRORS ON SENSE  SINCE UNIT CHECK SAYS CONTR   10530295
* * * *                UNIT IS OPERATIONAL                              10530296
* * * *      ASSUME  NO OUTSTANDING INTRPS SINCE GOT SOME KIND OF ENDA  10530297
* * * *              SHORT WHILE BACK                                   10530298
       TIO   0(9)                                                       10530299
       BC   2,*-4            WAIT FOR END OF SENSE                      10530300
       MVC   64(12),SYSVCW                   RESTORS   CSW  CAW         10530301
       IC    8,SYSQCT                   READY TO STEP COUNTER           10530302
SYSCSP LA    8,1(8)                     ADD ONT TO COUNTER              10530303
       STC   8,SYSQCT                   PUT CNTR IN CORE                10530304
       LH     8,4(13)                   PULL SYMBOLIC UNIT              10530305
       IC     8,SYSUTB+2(8)              PULL DEVICE TYPE               10530306
       LH    8,SYSXTE(8)               PULL TABLE ADDRESS               10530307
       BCR   15,8                                                       10530308
SYSQCC MVI   50,X'0F'                   CHANNEL ERROR                   10530309
       LPSW   112                       SIMULATE MACH CHECK             10530310
SYSXMN   MVI     50,X'3F'          NOT OPERATIONAL  3F                  10530311
       LH    13,SYSQMX(12)              PULL CCB ADDRESS                10530312
*            * * * DISTASTER OR DUMP EXIT * * *                         10530313
SYSQXD OI    2(13),X'20'                DISASTER BIT                    10530314
       TM    2(13),X'10'                ACCEPT BAD I/O                  10530315
       BC    1,SYSQXK                   YES  CONTINUE  NO CLEAR DISAST  10530316
* * *  DISASTER BIT ONLY BELONGS ON IF BITS X'11' I(13) ARE ON * * * *  10530317
       LPSW    112                                                      10530318
* * *  OPERATOR CHOICE EXIT                                             10530319
SYSQXP UNPK  SYSHLD(5),58(3)            PUT CH/UN REL                   10530320
SYSC08   EQU   *-4                     CONSTANT OF 8                    10530321
       UNPK  SYSHLD+4(5),SYSENS(3)      UNPACK SENSE INFO               10530322
       TR    SYSHLD(8),SYSTBL-240       CONVERT HEX TO CHARACTER FOR PR 10530323
       MVC   SYSXM1(4),SYSHLD           SET MESSG1 FOR MACRO            10530324
       MVC   SYSXM2(4),SYSHLD+4         SET MESSG2 FOR MACRO            10530325
         STM   12,13,SYSDRG             SAVE REGISTERS SINCE SUP USES T 10530326
       SVC   2           CALL VOR MESSAGE                               10530327
SYSXM1   DC    C'CHUN  '                CHANNEL AND UNIT MESSAGE        10530328
       SVC   2           CALL FOR MESSAGE                               10530329
SYSXM2   DC    C'SENSA '                SENSE MESSAGE                   10530330
         LM    12,13,SYSDRG             RESTORE SAVED REGISTER S        10530331
       CLI   SYSXM2+5,C'5'              IS REPLY RETRY                  10530332
* * *  RETRY EXIT                                                       10530333
       BC    8,SYSQXR                   GO TO RTN                       10530334
*            * ** CONTINUE EXIT         * * *                           10530335
SYSQXC NI    2(13),X'DF'                TURN OFF DISASTER BIT           10530336
SYSQXK CLI   SYSQXR+1,X'00'             WAS THIS I/O FROM RROR RTN      10530337
SYSXEE   MVI     SYSQXR+1,X'F0'    SWITCH FOR RESET OPER  SET IT TO BR  10530338
          BC     8,2(10)                   RETURN TO ERR RTN            10530339
       BAL   13,SYSVRR                 RESTORE REGISTERS                10530340
SYSWDE BC  0,SYSPDE                                                     10530341
       LH    13,SYSQMX-SYSS00(12)       LOAD CCB ADDRESS F              10530342
       BC    15,SYSWUP                  UPDATE AND CONTINUE             10530343
SYSQXR BC    15,SYSUA1                  NORMAL RETRY                    10530344
SYSQXS MVC   74(2),0(10)                LOAD CAW                        10530345
       LH    13,58          SET UP CHANNEL,UNIT ADDRESS                 10530346
       OI    SYSWUP+1,X'F0'             TURN SWUP TO BRANCH             10530347
         MVI     SYSQXR+1,X'00'    SWITCH FOR RESET OPER  NOP           10530348
         MVI     SYSWFH+1,X'00'    NOP  SWITCH                          10530349
       BC    15,SYSWFH+4                USE  NORMAL START AND TESTS     10530350
SYSSOF   TM    2(13),X'02'              TEST SELECTED ERROR BIT         10530351
         BCR   8,1                      EXIT IF NOT ON                  10530352
         B     SYSXEE                  CONTINUE IF ON                   10530353
SYSXAT   EQU  *                                                         10530354
SYSUNX   LA    12,SYSVCB                 INITIALIZE SEARCH FOR DEV END  10530355
SYSAL1   SH    12,SYSC02                 SUBTRACT 2                     10530356
         CLI   0(12),X'00'              NO CCB                          10530357
         BE    SYSA00                   NONE TRY TESTING Q              10530358
         LH    13,0(12)                 PULL CCB                        10530359
         LH    13,4(13)                 PULL SYMBOL UNIT                10530360
         CLC   SYSUTB-SYSS00(2,13),58   COMPARE INTR CR/UNIT/S CCB C/UN 10530361
         BNE   SYSAL1                   NOT THIS DEVICE                 10530362
         MVI   SYSWUP+1,X'F0'           CUT AT END OF CHECKS            10530363
         MVI   SYSWDE+1,X'F0'           RETURN HERE  DEV END SWITCH     10530364
         LH    13,0(12)                 SET CCB                         10530365
         B     SYSXBB+4                 SIGNIF.INT-CHECK CONDITIONS W/R 10530366
SYSPDE   MVI   SYSWDE+1,X'00'           NOP  DEV END SW                 10530367
         SH    12,SYSC02                POP UP LIST                     10530368
         MVC   2(2,12),0(12)            UPDATE OUTSTANDING D.E POSSIBLE 10530369
         CLI   0(12),0                  END OF SIG LIST                 10530370
         BNE   SYSPDE+4                 POP UP THE LIST                 10530371
SYSA00   SR    12,12                    SET REG 12 IF ANY SEL CH S POIN 10530372
       IC    12,58                       INSERT CHANNEL                 10530373
       AR    12,12                      DOUBLE CHANNEL                  10530374
SYSQTS CLI   SYSXPT-SYSS00(12),X'07'    AT DEVICE END  NEED TO TST EXPT 10530375
       BC    4,SYSXIT                   LESS,REALL CHANNEL NUMBER       10530376
     B     SYSQTT                                                       10530377
* * *    CHECK DEVICE END                                               10530378
SYSC02 DC  H'2'                                                         10530379
* * *    DESIGNED FOR PRTOV MACRO                                       10530380
       DC  H'0'                                                         10530381
SYSA01 DC   2H'0'                       PUSH DOWN LIST FOR DVE SIG CCB  10530382
       DC   2H'0'                                                       10530383
LAST   DC   2H'0'                                                       10530384
SYSVCB DC    H'0'                                                       10530385
L      EQU   SYSVCB-SYSA01              LINGTH OF PUSH DOWN LIST        10530386
SYSLNG EQU   SYSVCB-SYSA01              LENGTH OF PUSH DOWN LIST        10530387
* * *    IF DEVICE END SIGNIFIGANT, TEST CH9,CH12,WITH I/O ERROR RTNS.  10530388
SYSXZA DC    X'00001F000F'              MASK,AND BYTES 0-3 OFF          10530389
SYSQCT DC    X'0'                  COUNTER FOR ERROR ROUTINES           10530390
*      TABLE  OF ERROR ENTRYS           * * *                           10530391
SYSXTE DC   Y(SYSTER)           TAPE ERROR RTN                          10530392
       DC      Y(SYSUIS)                1052 TYPEWRITER  ERROR          10530393
       DC      Y(SYSUAA)                1442 READ/PCH   ERROR           10530394
       DC      Y(SYSUCG)                1403 PRINTER    ERR/R           10530395
       DC      Y(SYSUCD)                1402  READER    ERR/R           10530396
       DC      Y(SYSUCC)                1402 PUNCH,PFR  ERR/R           10530397
       DC     Y(SYSD10)           DISK ROUTINES                         10530398
       DC      Y(SYSUKA)                1015 ERROR ROUTINES             10530399
       DC      Y(SYSP00)                2671 ERROR ROUTINES             10530400
       DC      Y(SYSUAB)                1443 PRINTER   ERROR            10530401
SYSUKA EQU   SYSQXD                     NO 1015 ERROR ROUTINES          10530402
SYSD10   EQU   SYSQXD                                                   10530403
SYSP00 EQU   SYSQXD                     NO 2671 ERROR ROUTINES          10530404
SYSXSC DC      Y(SYSXSN)                ADDR OF SENSE CCW               10530405
*                                                                       10530406
SYSQMX DC    3H'0'                      HEAD Q FOR MULTPLX,2SEL         10530407
SYSMSG   DC      Y(SYSSCB-2)           POINT TO CCB FOR SVC2            10530408
SYSXCN DC    X'807F'                    OR CH USE BYTE    AND IT OFF    10530409
       DC    X'40BF'                    OR CH USE BYTE    AND IT OFF    10530410
       DC    X'20DF'                    OR CH USE BYTE    AND IT OFF    10530411
SYSXPT DC    3X'0700'                   EXPECT INTERRUPT ON CHANNL      10530412
       DC     X'0700'                                                   10530413
***   AREA FOR SAVING REGISTERS                                         10530414
SYSVRX   DS    11F                      ROOM TO SAVE REMAINING REG.     10530415
SYSDRG   DS    D                                                        10530416
SETMOD   CCW   X'03',SETMOD,X'60',80     SET MODE COMMAND               10530417
SYSTIC   DC    X'08000000'              TIC COMMAND                     10530418
ADSTMD   DC      A(SETMOD)              ADDRESS OF SET MODE COMMAND     10530419
       DC  X'00FAFBFCFDFEFF00'          TRANSLATE LETT5RS 256OR5 G+     10530420
SYSXSN CCW   X'04',SYSENS,X'20',6       SENSE BYTES I/O CCW             10530421
SYSVCW   DC    3F'0'                                                    10530422
SYSAVE DC    A(SYSQXD)                  EXIT   DISASTER                 10530423
       DC    A(SYSQXC)                  EXIT   CONTINUE                 10530424
       DC    A(SYSQXR)                  EXIT   RETRY                    10530425
       DC    A(SYSQXP)                  EXIT   OPERATOR CHOICE          10530426
       DC    A(SYSQXS)                  EXIT   START I/O FOR ADJ BACKSP 10530427
SYSTBL DC    CL16'0123456789ABCDEF'            TABLE LOOK UP FOR HEX TR 10530428
*        **********  /360 TAPE ERROR ROUTINE  **********                10530429
         DS    0D                      START PROGRAM ON DOUBLE WORD     10530430
SYSTOS   EQU   6                       EQU TO GEN REG 6                 10530431
SYSTOT   EQU   7                       EQU TO GEN REG 7                 10530432
SYSTIO   EQU   10                      EQU TO GEN REG 10                10530433
SYSTIA   EQU   11                      EQU TO GEN REG 11                10530434
SYSTOP   EQU   13                      EQU TO GEN REG 13                10530435
SYST22   DC    X'2700000140000001'     BACKSPACE CCW + CHAIN FLAG       10530436
SYST33   DC    X'1700000100000001'     ERASE GAP CCW                    10530437
SYST44   DC    X'3700000100000001'     FWD, BKSP OR NOP CCW             10530438
SYST55   CCW   X'04',SYST66,X'20',2    SENSE CCW                        10530439
SYST66   DC    H'0'                    SENSE READ IN AREA               10530440
SYSTER   TM    SYSENS,X'FF'            ANY SENSE DATA                   10530441
         BCR   8,SYSUXC                                                 10530442
         MVI   SYST44,X'27'            MODIFY CCW TO BKSP               10530443
         TM    SYSENS,X'22'            BUS OUT CHECK OR WORD COUNT ZERO 10530444
         BC    5,SYST10                                                 10530445
         BAL   SYSTIO,SYSTSE           GO TO SUB-ROUT.--EQUIP + INT REQ 10530446
         MVN   SYST44+3(1),0(SYSTIA)   GET OP CODE FROM CCW COMMAND     10530447
         NI    SYST44+3,X'07'          REMOVE MOD BIT IF RD BKWD COMMD  10530448
         TM    SYSENS,X'0C'            TEST FOR DATA OR OVERRUN CHECK   10530449
         BC    7,SYST01                                                 10530450
         TM    3(13),X'08'              TEST DATA CONVERTOR             10530451
         BZ    SYST11                   NO                              10530452
         OI    3(SYSTOP),X'08'          SET DATA CONVERTOR              10530453
       BR      SYSUXC                                                   10530454
SYST01   CLI   SYST44+3,X'04'          IS THIS A RD BKWD COMMAND        10530455
         BC    7,SYST02                NO,                              10530456
         MVI   SYST44,X'37'            YES, MODIFY CCW TO FRDSPACE      10530457
SYST02   TM    SYSENS,X'04'            IS THIS AN OVERRUN CONDITION     10530458
         BO    SYST03                  YES                              10530459
         TM  SYSENS+1,X'80'             NOISE RECORD                    10530460
         BC   1,SYSTXY                                                  10530461
         LH    7,6(11)                  PLACE ORIG CT IN 7              10530462
         SH   7,70    SUB  RESID  CT                                    10530463
         LA    6,12                                                     10530464
         CR    7,6                                                      10530465
         BCR   4,SYSUXR                 RETRY  NOISE REC IF CT LESS 12  10530466
SYSTXY   CLI   SYST44+3,X'01'          IS THIS A WRITE OPER             10530467
         BZ    SYST05                  YES                              10530468
         TM    SYSQCT,X'07'            HAS 8 ATTEMPTS BEEN TRIED        10530469
         BZ    SYST06                  YES                              10530470
         TM    SYSENS+1,X'10'          IS THIS A 7 TRACK OPER           10530471
         BO    SYST03                  YES                              10530472
         TM    SYSENS+2,X'FF'          HAS TRACK IN ERROR BEEN IDENT    10530473
         BC    7,SYST03                NO                               10530474
         BALR  SYSTIO,SYSUXS                                            10530475
         DC      Y(SYST44)                REQUEST EXECUTED              10530476
         MVI   SYST44,X'1B'            MODIFY CCW OP TO REQUEST TIE     10530477
SYST03   CLI   SYSQCT,100                                               10530478
         BC    10,SYST04               YES                              10530479
         BALR  SYSTIO,SYSUXS                                            10530480
         DC      Y(SYST44)                REQUEST EXECUTED              10530481
SYSTBS   STH   SYSTIA,SYSTDC            CCW ADDRESS IS PLACED IN RETURN 10530482
         BALR  SYSTIO,SYSUXS                                            10530483
SYSTDC   DC      Y(SYSTDC)              WITH NEW CCW                    10530484
       BR    SYSUXC                     CONTINUE                        10530485
SYST04   TM    SYSENS,X'04'            TEST FOR OVERRUN CONDITION       10530486
         BCR   1,SYSUXD                                                 10530487
         OI    3(SYSTOP),X'10'          SET UNCORRECTABLE RD ERR        10530488
         B     SYSSOF                                                   10530489
SYST05   BALR  SYSTIO,SYSUXS                                            10530490
         DC      Y(SYST22)                ERASE GAP                     10530491
         CLI   SYSQCT,4                TEST FOR 3 WRITE ATTEMPTS        10530492
         BCR   4,SYSUXR                                                 10530493
         MVI   SYSENS+1,X'F3'          INIT '3 WRITE ERRORS' MESSG.     10530494
         BR    SYSUXD                                                   10530495
SYST06   MVI   SYST44,X'27'            ROUTINE                          10530496
         LA    SYSTOS,3                 TO                              10530497
         LH    SYSTOT,SYST44+2           INCORPORATE                    10530498
SYST07   BALR  SYSTIO,SYSUXS                                            10530499
         DC      Y(SYST44)                 CLEANING                     10530500
         BALR  SYSTIO,SYSUXS                                            10530501
         DC      Y(SYST55)                   WHEN                       10530502
         TM    SYST66+1,X'08'                 EVER                      10530503
         BO    SYST08                          8                        10530504
         BCT   SYSTOS,SYST07                    READ                    10530505
SYST08   XI    SYST44,X'10'                      ERRORS                 10530506
         SR    SYSTOT,SYSTOS                      ARE                   10530507
         BCR   8,SYSUXR                                                 10530508
SYST09   BALR  SYSTIO,SYSUXS                                            10530509
         DC      Y(SYST44)                                              10530510
         BCT   SYSTOT,SYST09                                            10530511
         B     SYSTBS                  EXIT TO RETRY                    10530512
SYST10   CLI   SYSQCT,3                TEST COUNTER FOR 3 ATTEMPTS      10530513
         BCR   10,SYSUXD                                                10530514
         TM      SYSENS,X'02'           READ CT ZERO                    10530515
         BCR   1,SYSUXR                                                 10530516
         CLI   SYST44+3,X'01'          IS COMMAND A WRITE OPER          10530517
         BCR   7,SYSUXR                                                 10530518
         B     SYST03                                                   10530519
SYST11   CLI   SYST44+3,3              TEST FOR SET MODE COMMAND        10530520
         CLI   SYST44+3,3              TEST FOR SET MODE COMMAND        10530521
         BCR   8,SYSUXD                                                 10530522
         BR    SYSUXP                                                   10530523
*                                                                       10530524
SYSUXD EQU   1         REGISTER 1     DISASTER                          10530525
SYSUXC EQU   2           REGISTER 3  NO ERROR  CONTINUE                 10530526
SYSUXR EQU   3           REGISTER 3  RETRY THE LAST CCB                 10530527
SYSUXP EQU   4          GREGISTER 4   OPERATOR CHOICE                   10530528
SYSUXS EQU   5           REGISTER 5  ROUTINE FOR RESET,BACKSPACE,ETC    10530529
SYSTSE   TM      SYSENS,X'10'      EQUITMENT CHECK                      10530530
         BCR     1,SYSUXD                                               10530531
SYSTSO   TM      SYSENS,X'40'      OPERATIO INTERVENTION                10530532
         BCR     1,SYSUXP          GO TO OPERATIO  CHOICE               10530533
         BR    10                                                       10530534
***** ERROR ROUTINE FOR PRINTERS,READERS AND PUNCH FOR TAPE SYSTEM ***  10530535
SYSTSU   TM    SYSENS,X'58'                                             10530536
         BCR   5,SYSUXP                                                 10530537
SYSUBT TM    SYSENS,X'20'               BASIC TEST ROUTINE     BUSS OUT 10530538
       BC    1,SYSUIS                   BUS OUT,SWITCH FOR RETRY        10530539
       TM    SYSENS,X'80'               COMMAND REJECT                  10530540
       BCR   1,SYSUXD                   GO TO DISASTER                  10530541
       BR    10                         NONE OF THESE  RETURN TO DEV RT 10530542
***** ENTER ROUTINE HERE FOR 1402 PUNCH ERROR *****                     10530543
SYSUCC TM    SYSENS,X'10'               EQUIPMENT CHECK                 10530544
       BC    8,SYSUCD                   NO,USE 1402R ROUTINES           10530545
SYSUDA   OI    3(13),X'11'             SET BIT IN CCB                   10530546
         B     SYSSOF                   EXIT TO TEST SOFT ERR BIT       10530547
***** ENTER ROUTINE HERE FOR 1402 READER ERROR *****                    10530548
SYSUCD   NI    SYSUIS+1,X'0F'           KNOW CAN RETRY BUS OUT ON 1402  10530549
       BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10530550
SYSUDB   OI       3(13),X'08'     SET BIT IN CCB                        10530551
         BR    SYSUXC             BRANCH TO CONTINUE                    10530552
***** ENTER ROUTINE HERE IF 1403 OR 1404 ERROR *****                    10530553
SYSUCG BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10530554
       TM    SYSENS,X'02'               USUSUAL COMMAND SEQUENCE        10530555
       BC    1,SYSUDB                   USE POSTING RTN                 10530556
       OI    3(13),X'02'                SET CH 9 OVERFLOW BIT           10530557
         BC    15,SYSUDE                CONTINUE                        10530558
***** ENTER ROUTINE HERE IF 1442,2520 OR 2501 ERROR *****               10530559
SYSUAA BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10530560
         BR      SYSUXP           BRANCH TO OPERATOR CHOICE             10530561
***** ENTER ROUTINE HERE FOR 1443         ERROR *****                   10530562
*      1403  ALSO- COULD B UCG+4 * * *                                  10530563
SYSUAB   NI   SYSENS,X'F3'                                              10530564
       BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10530565
         TM    SYSENS,X'01'                                             10530566
         BCR   8,SYSUXC                                                 10530567
       OI    3(13),X'02'                SET BIT IN CCB                  10530568
         BC    15,SYSUDE                                                10530569
***** ENTER ROUTINE HERE FOR 1052 ERROR ALSO COMMON BUS-OUT ROUTINE     10530570
SYSUIS BCR   15,SYSUXP                  OPERATOR CHOICE IF COMMAND EXEC 10530571
       CLI   SYSQCT,3                   TRIED 3 TIMES                   10530572
       BCR   12,SYSUXR                  RETRRY                          10530573
       BR    SYSUXP                     OPERATIOR CHOICE                10530574
SYSSND EQU   *        ENS OF SUPERVISOR                                 10530575
*                                                                       10530576
ABSLUT     SVC   0                                                      10530577
SYSLDR EQU   ABSLUT                                                     10530578
READCD  EQU  ABSLUT                                                     10530579
           DC    YL2(CCCB)                                              10530580
       TM    CCCB+2,X'80'       WAIT FOR END                            10530581
       BZ   *-4                                                         10530582
TEXTCD     EQU   *                                                      10530583
       L     15,INPUT                  3 TESTS CHEAPER WITH REGISTER    10530584
       CL    15,CREP                                                    10530585
       BZ    REPRUT                                                     10530586
           L     14,INPUT+4              SET UP ADDRESS EITHER BR OR DA 10530587
       CL    15,CEND                                                    10530588
       BCR   8,14               END CARD, GOT TO ADDRESS                10530589
       CL    15,CTXT                                                    10530590
       BC    7,READCD                  NOT  ANDY LIGIT CZRD IGNORE IT   10530591
           LH    15,INPUT+10            COUNT                           10530592
TXTCNT  BCTR  15,0       REDUCE COUNT BY 1                              10530593
           STC   15,MOVETX+1                                            10530594
MOVETX     MVC   0(0,14),INPUT+16        MOVE DATA                      10530595
       B     READCD                                                     10530596
REPRUT TR    INPUT+6(6),SYSTBL-240      BYTE TO HEX   C1 = FA  ETC      10530597
       PACK  INPUT(5),INPUT+6(7)          ADDRESS TO HEX                10530598
       LA    14,INPUT+11                FROM ADDRESS  FIRST REPLACE     10530599
       LA    15,INPUT+16                INTO ADDRESS  FIRST REPLACE     10530600
REPLP  LA    14,5(14)                   ADD 5 TO FROM ADDRESS           10530601
       MVC   SAVE(4),0(14)              SAVE  4 BYTES                   10530602
       TR    SAVE(4),SYSTBL-240         BYTE TO HEX                     10530603
       PACK   0(3,15),SAVE(5)           PACK, DROP SIGN  ZONES          10530604
       LA    15,2(15)                   MODIFY INTO ADDR                10530605
       CLI   4(14),C','                 IS IT COMMA  LAST MUST BE BLANK 10530606
       BC    8,REPLP                    YES, MORE BYTES                 10530607
REPXT  SH    15,REPRUT+18               COUNT OF BYTES REPLACES         10530608
       L     14,INPUT                   ADDRESS OF FIRST BYTE           10530609
       B     TXTCNT                                                     10530610
SAVE   DC    X'00000000'    ROOM FOR PACK  ETC                          10530611
INPUT      DS    10D                                                    10530612
MSCCW3     DC    X'02'             READ                                 10530613
            DC   AL3(INPUT)                                             10530614
           DC    A(80)                                                  10530615
CTXT       DC    X'02E3E7E3'                                            10530616
CEND       DC    X'02C5D5C4'                                            10530617
CCCB       DC    F'0'                                                   10530618
           DC    H'4'                                                   10530619
           DC    YL2(MSCCW3)                                            10530620
CREP   DC    X'02'                                                      10530621
       DC    C'REP'                                                     10530622
JOBCT      LPSW  SYSSLB                                                 10530623
       END  JOBCT                                                       10530624
         TITLE 'JOB CONTROL'                                            10530625
NRSUP    START 0                                                        10530626
         USING *,0,4                                                    10530627
SJW4RG   EQU   1                                                        10530628
SJCCRG   EQU   2                        CARD INDEX REGISTER             10530629
SJCTRG   EQU   4                        COUNTING REGISTER               10530630
SJW1RG   EQU   5                        WORK REGISTER                   10530631
SJW2RG   EQU   6                        WORK REGISTER                   10530632
SJW3RG   EQU   7                        WORK REGISTER                   10530633
SJTBRG   EQU   8                        TABLE INDEX REGISTER            10530634
SJCRRG   EQU   9              CONTAINS ADDR OF START OF COMMUNICAT REG  10530635
SJFBRG   EQU   10                  CONTAINS ADDR OF FILL BUCKET ROUTINE 10530636
SJSBRG   EQU   11                  CONTAINS ADDR OF SKIP BLANKS ROUTINE 10530637
SJBRRG   EQU   14                       SUBROUTINE ADDR REGISTER        10530638
SJLKRG   EQU   15                       RETURN LINKAGE REGISTER         10530639
SJCRJB   EQU   38                  JOB CONTROL BYTE IN COMMUN. REGION   10530640
SJCRJC   EQU   39                  JOB CONTROL BYTE IN COMMUN. REGION   10530641
SJCRUP   EQU   23                  UPSI BYTE                            10530642
SJCRCF   EQU   9                   CONFIGURATION BYTE                   10530643
SJCRMO   EQU   0                   MONTH-2 BYTES                        10530644
SJCRDA   EQU   2                   DAY-2BYTES                           10530645
SJCRYR   EQU   4                   YEAR-5BYTES                          10530646
SJCRNM   EQU   24                  NAME-6BYTES                          10530647
SJCRUS   EQU   20                                                       10530648
         ORG   NRSUP+4096                                               10530649
START    BALR  3,0                                                      10530650
         USING *,3                                                      10530651
         LH    SJCRRG,20     SET CRREG TO ADDR OF COMM. REGION          10530652
         LA    SJFBRG,SJFLBK       INIT REG TO ADDR OF FILL BUCKET ROUT 10530653
         LA    SJSBRG,SJSKBL       INIT REG TO ADDR OF SKIP BLANKS ROUT 10530654
         MVI   SJCRUP(SJCRRG),X'00'    ZERO UPSI BYTE                   10530655
         MVC   SJEOJM+6(6),SJCRNM(SJCRRG)        PUT NAME IN EOJ MESG   10530656
         TM    SJCRJB(SJCRRG),X'02'          IS JOB FLAG ON             10530657
         BC   14,SJNEOJ                      BRANCH NOT EQUAL           10530658
         TM    SJCRJB(SJCRRG),X'80'          IS LOG FLAG ON             10530659
         BC   14,SJNEOJ                                                 10530660
         MVI   SJEOJM,C'N'                   INIT FOR NORMAL EOJ  MSG   10530661
         TM    SJCRJB(SJCRRG),X'01'          WAS JOB ABORTED            10530662
         BC   14,SJTEOJ                                                 10530663
         MVI   SJEOJM,C'A'                   INIT FOR ABNORMAL EOJ MSG  10530664
SJTEOJ   SVC   0                             WRITE EOJ MESSAGE          10530665
         DC    YL2(SJECCB)                                              10530666
         TM    SJECCB+2,X'80'                                           10530667
         BC    8,*-4                                                    10530668
SJNEOJ   NI    SJCRJB(SJCRRG),X'80'          RESET ALL BUT LOG FLAG     10530669
         MVC   SJCRUS(3,SJCRRG),SJNUMT                                  10530670
SJREAD   SR    SJCTRG,SJCTRG                                            10530671
         SR    SJW1RG,SJW1RG                                            10530672
         SR    SJW2RG,SJW2RG                                            10530673
         SR    SJW3RG,SJW3RG                                            10530674
         SR    SJW4RG,SJW4RG                                            10530675
         BAL   SJLKRG,SJRDCD                                            10530676
         CLC   SJINPT(3),SJKCTL         TEST IF CONTROL CARD            10530677
         BNE   SJNOSL                  GO TO NO SLASH ROUTINE           10530678
         BAL   SJLKRG,SJDISP                                            10530679
         LA    SJCCRG,SJINPT+2                                          10530680
         BALR  SJLKRG,SJSBRG                                            10530681
         BALR  SJLKRG,SJFBRG                                            10530682
         SR    0,0                                                      10530683
         CLI   SJBUCK+5,C' '            IS VERB GREATER THAN 5 CHAR     10530684
         BNE   SJNOCC                                                   10530685
         CLI   0(SJCCRG),C','           DID COMMA FOLLOW THE VERB       10530686
         BE    SJNOCC                                                   10530687
SJNOBR   BC    0,SJVOL1                NOP-BRANCH SWITCH                10530688
         CLC   SJBUCK(5),SJKPAU         TEST FOR PAUSE CARD             10530689
         BE    SJPAUS                                                   10530690
         CLC   SJBUCK(4),SJKJOB         TEST FOR JOB CARD               10530691
         BE    SJJOB                                                    10530692
         CLC   SJBUCK(4),SJKLOG                                         10530693
         BE    SJLOG                                                    10530694
         CLC   SJBUCK(5),SJKNLG             TEST FOR NOLOG CARD         10530695
         BE    SJNLOG                                                   10530696
         TM    SJCRJB(SJCRRG),X'02'     TEST JOB CARD FLAG              10530697
         BZ    SJNOJC                                                   10530698
         LA    SJTBRG,SJTABL       SET REG TO BEGIN OF CTL CD TABLE     10530699
SJCCLU   CLC   2(5,SJTBRG),SJBUCK       COMPARE TABLE ENTRY             10530700
         BE    SJFND                                                    10530701
         CLC   2(5,SJTBRG),SJKASG       TEST FOR END OF TABLE           10530702
         BE    SJNOCC                                                   10530703
         LA    SJTBRG,7(SJTBRG)         INCREMENT FOR NEXT TABLE ENTRY  10530704
         B     SJCCLU                   LOOP FOR NEXT TABLE ENTRY       10530705
SJFND    MVC   SJBCK1(2),0(SJTBRG)                                      10530706
         LH    SJBRRG,SJBCK1            LOAD REG WITH ROUTINE ADDR      10530707
         BR    SJBRRG                   BRANCH TO ROUTINE               10530708
SJRDCD   LA    SJCCRG,SJINPT            INIT CONTROL CARD REGISTER      10530709
         SVC   0                                                        10530710
         DC    YL2(SJCCB)                                               10530711
SJRD1    TM    SJCCB+2,X'80'                                            10530712
         BC    8,SJRD1                                                  10530713
         TM    SJCCB+3,X'04'           TEST EOF                         10530714
         BC    1,SJRDCD                YES-LET IOCS ISSUE MESSAGE       10530715
         BR    SJLKRG                                                   10530716
SJSKBL   CH    SJCCRG,SJEOC            TEST FOR END OF CARD             10530717
         BCR   10,SJLKRG                                                10530718
         CLI   1(SJCCRG),C' '          COMPARE FOR BLANK                10530719
         BNE   0(SJLKRG)                RETURN                          10530720
         LA    SJCCRG,1(SJCCRG)                                         10530721
         B     SJSKBL                                                   10530722
SJFLBK   MVC   SJBUCK,SJ9BLK           BLANK BUCKET                     10530723
         AH    0,SJK01                                                  10530724
         LA    SJW1RG,SJBUCK                                            10530725
SJFB1    CLI   1(SJCCRG),C' '           TEST FOR BLANK                  10530726
         BE    SJBKFL                                                   10530727
         CLI   1(SJCCRG),C','           TEST FOR COMMA                  10530728
         BE    SJBKFL                                                   10530729
         CH    SJCCRG,SJEOC                                             10530730
         BCR   8,SJLKRG                                                 10530731
         CH    SJW1RG,SJEOB             TEST FOR OVERFLOW OF BUCKET     10530732
         BE    SJFB2                                                    10530733
         MVC   0(1,SJW1RG),1(SJCCRG)                                    10530734
         LA    SJW1RG,1(SJW1RG)                                         10530735
SJFB2    LA    SJCCRG,1(SJCCRG)                                         10530736
         B     SJFB1                                                    10530737
SJBKFL   LA    SJCCRG,1(SJCCRG)                                         10530738
         BR    SJLKRG                                                   10530739
SJCNVB   BALR  SJLKRG,SJSBRG            SKIP BLANKS                     10530740
         BALR  SJLKRG,SJFBRG            FILL BUCKET                     10530741
         CLI   SJBUCK+8,C' '                                            10530742
         BNE   SJCCER                                                   10530743
         CLI   0(SJCCRG),C' '           DID BLANK STOP THE SCAN         10530744
         BNE   SJCCER                                                   10530745
         LH    SJCTRG,SJK008            SET COUNTER TO 8                10530746
         LA    SJTBRG,SJBUCK+7          SET REG TO END OF BUCKET ADDR   10530747
         SR    SJW2RG,SJW2RG            ZERO WORK REG                   10530748
SJCVB1   IC    SJW2RG,0(SJTBRG)         PUT ONE CHAR OF PARAM INTO REG  10530749
         CLI   0(SJTBRG),C'1'           IS CHAR A 1                     10530750
         BE    SJCVB2                                                   10530751
         SRL   SJW3RG,1                 SHIFT ODD REG INSERTING A ZERO  10530752
         B     SJCVB3                                                   10530753
SJCVB2   SRDL  SJW2RG,1            PUT A 1 IN HIGH ORDER OF ODD REG     10530754
SJCVB3   BCTR  SJTBRG,0                 SUBTRACT 1 FROM BUCKED ADDR REG 10530755
         BCT   SJCTRG,SJCVB1            LOOP 7 TIMES                    10530756
         SRL   SJW3RG,24           SHIFT HIGH BYTE TO LOW ORDER OF REG  10530757
         BR    SJBRRG                   RETURN TO CONFG OR UPSI ROUTINE 10530758
SJCONF   BAL   SJBRRG,SJCNVB            CONVERT 8 CHARS TO ONE BYTE     10530759
         STC   SJW3RG,SJCRCF(SJCRRG)         STORE CONFG BYTE IN CR     10530760
         B     SJREAD                   GET NEXT CARD                   10530761
SJUPSI   BAL   SJBRRG,SJCNVB            CONVERT 8 CHARS TO ONE BYTE     10530762
         STC   SJW3RG,SJUPSS+1         STORE CHAR IN MASK               10530763
SJUPSS   OI    SJCRUP(SJCRRG),0        OR UPSI CHAR TO UPSI BYTE        10530764
         B     SJREAD                                                   10530765
SJJOB    TM    SJCRJB(SJCRRG),X'02'          IS JOB FLAG ON             10530766
         BC    1,SJJOB1                      IF ON,GO TO ERROR          10530767
         BALR  SJLKRG,SJSBRG                 SKIP BLANKS                10530768
         BALR  SJLKRG,SJFBRG                 FILL BUCKET                10530769
         MVC   SJCRNM(6,SJCRRG),SJBUCK       MOVE NAME INTO CR          10530770
         OI    SJCRJB(SJCRRG),X'02'          SET JOB FLAG ON            10530771
         B     SJREAD                                                   10530772
SJJOB1   NI    SJCRJB(SJCRRG),X'FD'     RESET JOB CARD FLAG             10530773
         MVC   SJMESG+3(3),SJMSG1       SET UP MESSAGE FOR DOP JOB CARD 10530774
         B     SJMESG                                                   10530775
SJPAUS   TM    SJCRJB(SJCRRG),X'02'     TEST JOB CARD FLAG              10530776
         BC    8,SJPAU1                                                 10530777
         OI    SJCRJB(SJCRRG),X'04'     SET PAUSE FLAG ON               10530778
         B     SJREAD                                                   10530779
SJPAU1   MVC   SJMESG+3(3),SJPMSG       INIT PAUSE MESSAGE              10530780
         B     SJMESG                                                   10530781
SJEXEC   EQU   *                                                        10530782
         LH    SJW1RG,22     POINT REG TO SYSLST PUB                    10530783
         LA    SJW1RG,08(SJW1RG)                                        10530784
         NI    SJCRJC(SJCRRG),X'7F'    RESET PRINTER SW                 10530785
         CLI   2(SJW1RG),X'06'         IS SYSLST A PRINTER              10530786
         BE    SJSPS                                                    10530787
         CLI   2(SJW1RG),X'12'                                          10530788
         BNE   SJEXQ1                                                   10530789
SJSPS    OI    SJCRJC(SJCRRG),X'80'          SET PRINTER SW             10530790
SJEXQ1   CLI   SJCRDA(SJCRRG),X'00'     TEST IF DATE WAS SUBMITTED      10530791
         BE    SJNODC                                                   10530792
         TM    SJCRJB(SJCRRG),X'04'     TEST PAUSE FLAG                 10530793
         BC    8,SJEXQ2                                                 10530794
         SVC   2                             DELAYED PAUSE              10530795
         DC    C'1703A '                                                10530796
SJEXQ2   EQU   *                                                        10530797
SJEXQ3   LH    SJW3RG,20               GET                              10530798
         NC    SJLBKT(1),9(SJW3RG)     HIGHEST                          10530799
         LH    SJW3RG,SJKON8           CORE                             10530800
         IC    0,SJLBKT                LOCATION                         10530801
         SRL   0,5                                                      10530802
         STC   0,*+7                                                    10530803
         SLL   SJW3RG,0                                                 10530804
         BCTR  SJW3RG,0                                                 10530805
         MVI   0(SJW3RG),C'*'                                           10530806
SJLAB3   BC    0,SJMLAB                                                 10530807
SJEXQ6   CLI   19,X'00'                ARE ALL I/O FINISHED             10530808
         BNE   SJEXQ6                                                   10530809
         SVC   1                        FETCH PROGRAM                   10530810
SJEXQ4   DC    C'SYSBPD'                                                10530811
SJDATE   BALR  SJLKRG,SJSBRG            SKIP BLANKS IN CTL CARD         10530812
         BALR  SJLKRG,SJFBRG            FILL BUCKET WITH DATE           10530813
* TEST FOR NON-NUMERIC CHARACTER IN DATE FIELD                          10530814
         MVC   SJBCK1(5),SJBUCK         PUT DATE IN TEMP BUCKET         10530815
         NC    SJBCK1(5),SJK5F0         CONVERT BYTES TO XXXX0000       10530816
         CLC   SJBCK1(5),SJK5F0         TEST IF XXXX0000 ARE 11110000   10530817
         BNE   SJCCER                   IF NO THERE IS A NON NUMERIC    10530818
         MVC   SJBCK1(5),SJBUCK         PUT DATE IN TEMP BUCKET         10530819
         NC    SJBCK1(5),SJK50F         CONVERT BYTES TO 0000XXXX       10530820
         TRT   SJBCK1(5),SJNUMT         TEST IF ANY NUMBER IS NOT 0-9   10530821
         BC    6,SJCCER                                                 10530822
         CLI   SJBUCK+5,C' '       IS DATE FIELD LONGER THAN 5 CHAR     10530823
         BNE   SJCCER                                                   10530824
         CLI   SJBUCK+4,C' '            IS DATE LESS THAN 5 CHAR        10530825
         BE    SJCCER                                                   10530826
         MVC   SJCRYR(5,SJCRRG),SJBUCK       STORE 5 CHAR DATE IN CR    10530827
         PACK  SJBCK1(8),SJBUCK(2)      PACK THE YEAR                   10530828
         CVB   SJW1RG,SJBCK1            CONVERT TO BINARY THE YEAR      10530829
         MVI   SJFEB,X'1C'             SET FEB TABLE ENTRY TO 28 DAYS   10530830
         N     SJW1RG,SJKW3             AND 0003 TO TEST FOR LEAP YEAR  10530831
         BNE   SJDAT1                                                   10530832
         MVI   SJFEB,X'1D'              SET FEB TABLE ENTRY TO 29 DAYS  10530833
SJDAT1   PACK  SJBCK1(8),SJBUCK+2(3)    PACK THE DAY                    10530834
         CVB   SJW1RG,SJBCK1            CONVERT THE DAY TO BINARY       10530835
         XR    SJCTRG,SJCTRG                                            10530836
         LA    SJTBRG,SJMOTB-1     SET TABLE REGISTER TO ADDR OF MO T12 10530837
SJDAT2   LA    SJCTRG,1(SJCTRG)         ADD ONE TO MONTH COUNTER        10530838
         LA    SJTBRG,1(SJTBRG)         ADD 4 TO TABLE REG              10530839
         STC   SJW1RG,SJDAT             SAVE DATE                       10530840
         IC    SJW2RG,0(SJTBRG)                                         10530841
         SR    SJW1RG,SJW2RG            SUBTRACT MONTH VALUE FROM DATE  10530842
         BP    SJDAT2                   LOOP ON A PLUS RESULT           10530843
         CVD   SJCTRG,SJBCK1            CONVERT MONTH COUNT TO DEC      10530844
         UNPK  SJCRMO(2,SJCRRG),SJBCK1(8)         STORE MONTH IN CR     10530845
         IC    SJCTRG,SJDAT                                             10530846
         CVD   SJCTRG,SJBCK1            CONVERT DAY TO DEC              10530847
         UNPK  SJCRDA(2,SJCRRG),SJBCK1(8)         STORE DAY IN CR       10530848
         OI    SJCRMO+1(SJCRRG),X'F0'                                   10530849
         OI    SJCRDA+1(SJCRRG),X'F0'                                   10530850
         CLC   SJCRMO(2,SJCRRG),SJK12        IS MONTH MORE THAN 12      10530851
         BNH   *+14                                                     10530852
         MVC   SJCRMO(9,SJCRRG),SJNUMT       ZERO DATE FIELD            10530853
         B     SJCCER                                                   10530854
         B     SJREAD                                                   10530855
SJNODC   MVC   SJMESG+3(3),SJNDCM       SET UP MESSAGE FOR NO DATE CARD 10530856
         B     SJMESG                                                   10530857
SJSYSR   BALR  SJLKRG,SJFBRG            PUT SYS*** PARAM INTO BUCKET    10530858
         CLI   0(SJCCRG),C','           TEST FOR COMMA AFTER PARAM 1    10530859
         BNE   SJCCER                                                   10530860
         CLI   SJBUCK+6,C' '                                            10530861
         BNE   SJCCER                                                   10530862
         CLC   SJBUCK(3),SJKSYS                                         10530863
         BNE   SJCCER                                                   10530864
         LA    SJW4RG,4                 PUT DISP FOR SYSRDR IN REG      10530865
         CLC   SJBUCK+3(3),SJKRDR       TEST FOR SYSRDR                 10530866
         BCR   8,SJBRRG                 BRANCH EQUAL                    10530867
         LA    SJW4RG,4(SJW4RG)                                         10530868
         CLC   SJBUCK+3(3),SJKLST       SYSLST                          10530869
         BCR   8,SJBRRG                 BRANCH EQUAL                    10530870
         LA    SJW4RG,4(SJW4RG)                                         10530871
         CLC   SJBUCK+3(3),SJKIPT       SYSIPT                          10530872
         BCR   8,SJBRRG                 BRANCH EQUAL                    10530873
         LA    SJW4RG,4(SJW4RG)                                         10530874
         CLC   SJBUCK+3(3),SJKOPT       SYSOPT                          10530875
         BCR   8,SJBRRG                 BRANCH EQUAL                    10530876
         LA    SJW4RG,4(SJW4RG)                                         10530877
         CLC   SJBUCK+3(3),SJKLOG       SYSLOG                          10530878
         BCR   8,SJBRRG                 BRANCH EQUAL                    10530879
         CLI   SJBUCK+5,C' '                                            10530880
         BE    SJCCER                                                   10530881
         TM    SJBUCK+3,X'F0'           TEST FOR NON NUMERIC ERROR      10530882
         BC    14,SJCCER                                                10530883
         TM    SJBUCK+4,X'F0'                                           10530884
         BC    14,SJCCER                                                10530885
         TM    SJBUCK+5,X'F0'                                           10530886
         BC    14,SJCCER                                                10530887
         PACK  SJBCK1(8),SJBUCK+3(3)    PACK INTO FULL WORD             10530888
         CVB   SJW1RG,SJBCK1            CONV PUB NO TO BINARY           10530889
         LA    SJW1RG,1(SJW1RG)        ALLOW FOR PUB 000                10530890
         STC   SJW1RG,SJSYS1+1                                          10530891
         LH    SJW2RG,22                LOAD PUB ADDR IN WORK REG       10530892
SJSYS1   CLI   3(SJW2RG),X'00'          IS THIS PUB IN THIS SYSTEM      10530893
         BL    SJCCER                                                   10530894
         SLL   SJW1RG,2                 MULT PUB NO BY 4                10530895
         AR    SJW4RG,SJW1RG            ADD PUB DISP TO TABLE REG       10530896
         BR    SJBRRG                                                   10530897
SJASGN   BALR  SJLKRG,SJSBRG            SKIP BLANKS AFTER VERB          10530898
         BAL   SJBRRG,SJSYSR                                            10530899
         AH    SJW4RG,22                                                10530900
SJASG2   BAL   SJLKRG,SJFLBK                                            10530901
         XC    SJPUB(4),SJPUB                                           10530902
         CLC   SJBUCK(3),SJKUA         SHOULD PUB BE UNASSIGNED         10530903
         BE    SJASG5                  LOAD EMPTY PUB                   10530904
         CLC   SJBUCK+5(2),SJKQB        TEST IF PAR2 IS X'XXX'          10530905
         BNE   SJCCER                                                   10530906
         CLC   SJBUCK(2),SJKHEX                                         10530907
         BNE   SJCCER                                                   10530908
         CLI   SJBUCK+2,C'2'            IS CHAN GREATER THAN 2          10530909
         BH    SJCCER                                                   10530910
         MVC   SJPUB(1),SJBUCK+2        STORE CHAN IN TEMP PUB          10530911
         NI    SJPUB,X'0F'              CONV CHAN NUMBER TO BINARY      10530912
         MVC   SJBCK1(2),SJBUCK+3       PLACE HEX CHARS IN BUCKET       10530913
         BAL   SJLKRG,SJCVHB            GO TO CONV HEX TO BINARY ROUTIN 10530914
         STC   SJW2RG,SJPUB+1           STORE UNIT NO IN TEMP PUB       10530915
         BAL   SJLKRG,SJFLBK                                            10530916
         CLI   SJBUCK+2,C' '            TEST IF PARAM IS MORE THAN 2CH  10530917
         BNE   SJCCER                                                   10530918
         LA    SJTBRG,SJDTAB            SET TABLE REG TO DEVICE TAB     10530919
         LA    SJCTRG,12                                                10530920
SJASG3   CLC   SJBUCK(2),1(SJTBRG)      COMPARE TABLE ENTRY TO DEV TYPE 10530921
         BE    SJASG4                                                   10530922
         LA    SJTBRG,3(SJTBRG)         INCR TO NEXT TABLE ENTRY        10530923
         BCT   SJCTRG,SJASG3            LOOP TILL END OF TABLE          10530924
         B     SJCCER                                                   10530925
SJASG4   MVC   SJPUB+2(1),0(SJTBRG)     STORE CODE IN PUB               10530926
         CLI   0(SJCCRG),C' '           IS THERE A PARAM4               10530927
         BE    SJASG5                                                   10530928
         BALR  SJLKRG,SJFBRG            MOVE PARAM4 TO BUCKET           10530929
         CLC   SJBUCK(2),SJKHEX         TEST IF PAR4 IS X'XX'           10530930
         BNE   SJCCER                                                   10530931
         CLC   SJBUCK+4(2),SJKQB                                        10530932
         BNE   SJCCER                                                   10530933
         MVC   SJBCK1(2),SJBUCK+2       PLACE HEX CHARS IN BUCKET       10530934
         BAL   SJLKRG,SJCVHB            CONVERT HEX TO BINARY           10530935
         STC   SJW2RG,SJPUB+3           STORE ANS.IN TEMP PUB           10530936
SJASG5   MVC   0(4,SJW4RG),SJPUB        MOVE NEW ASSIGNMENT TO PUB      10530937
         B     SJREAD                                                   10530938
SJCVHB   LA    SJW1RG,SJBCK1+1          POINT REG TO 2ND HEX CHAR       10530939
         LA    SJCTRG,2                 SET COUNTER TO 2                10530940
SJCHBA   SR    SJW2RG,SJW2RG            ZERO WORK REGISTER              10530941
         IC    SJW2RG,0(SJW1RG)         PUT HEX CHAR IN WORK REG        10530942
         TM    0(SJW1RG),X'F0'          IS IT 1111XXXX                  10530943
         BC    14,SJCHB1                BRANCH IF NOT 1111XXXX          10530944
         B     SJCHB2                                                   10530945
SJCHB1   LA    SJW2RG,09(SJW2RG)                                        10530946
         CLI   0(SJW1RG),C'F'                                           10530947
         BH    SJCCER                                                   10530948
         CLI   0(SJW1RG),C'A'                                           10530949
         BL    SJCCER                                                   10530950
SJCHB2   SRDL  SJW2RG,4                 SHIFT GOOD BITS TO ADJACENT REG 10530951
         BCTR  SJW1RG,0                 POINT REG TO 1ST HEX CHAR       10530952
         BCT   SJCTRG,SJCHBA            LOOP ONCE                       10530953
         SLDL  SJW2RG,8            SHIFT BINARY BYTE TO REG FOR STC     10530954
         BR    SJLKRG                                                   10530955
SJNOJC   MVC   SJMESG+3(3),SJNJCM       MOVE MESSAGE FOR NO JOB CARD    10530956
         B     SJMESG                                                   10530957
SJNOSL   MVC   SJMESG+3(3),SJMSG3                                       10530958
         B     SJNOCC+6                                                 10530959
SJNOCC   TM    SJCRJB(SJCRRG),X'02'                                     10530960
         BZ    SJREAD                                                   10530961
         MVC   SJMESG+3(3),SJMSG2                                       10530962
         B     SJMESG                                                   10530963
SJCCER   MVI   SJMESG+3,C'3'            CONTROL CARD ERROR              10530964
         STH   0,SJMESG+4                                               10530965
         OC    SJMESG+4(2),SJK5F0                                       10530966
SJMESG   SVC   2                        TELL SUPV TO DISPLAY MESSAGE    10530967
         DC    C'1   '                  MESSAGE TO BE DISPLAYED         10530968
         DC    C'A'                    RESPONSE REQUESTED               10530969
         DC    C' '                     RESPONSE CHARACTER-NOT USED     10530970
         B     SJREAD        READ NEXT CARD                             10530971
SJLOG    TM    SJCRJB(SJCRRG),X'80'          TEST LOG FLAG              10530972
         BC    1,SJREAD                      IF ON EXIT                 10530973
         OI    SJCRJB(SJCRRG),X'80'          SET LOG FLAG ON            10530974
         BAL   SJLKRG,SJDISP                                            10530975
         B     SJREAD                                                   10530976
SJNLOG   NI    SJCRJB(SJCRRG),X'7F'          RESET LOG FLAG             10530977
         B     SJREAD                                                   10530978
SJDISP   TM    SJCRJB(SJCRRG),X'80'          TEST LOG SW                10530979
         BCR   14,SJLKRG                     EXIT IF OFF                10530980
*   SCAN CARD FROM COL 80 FOR NON-BLANK ,COMPUTE LENGTH FOR CCW         10530981
         LA    SJCCRG,SJINPT+79        COMPUTE LENGTH FOR DISPLAYING    10530982
SJDSP1   CLI   0(SJCCRG),C' '                                           10530983
         BNE   SJDSP2                                                   10530984
         BCT   SJCCRG,SJDSP1                                            10530985
SJDSP2   SH    SJCCRG,SJAIPT                                            10530986
         STH   SJCCRG,SJDCCW+6                                          10530987
         SVC   0                                                        10530988
         DC    YL2(SJDCCB)                                              10530989
         TM    SJDCCB+2,X'80'                                           10530990
         BC    8,*-4                                                    10530991
         BR    SJLKRG                                                   10530992
SJAIPT   DC    YL2(SJINPT-1)                                            10530993
SJFILE   BALR  SJLKRG,SJSBRG                                            10530994
         BAL   SJBRRG,SJSYSR                                            10530995
         STC   SJW1RG,SJTCCB+5               STORE PUB DISP IN CCB      10530996
         CLI   2(SJW2RG),X'00'               TEST FOR TAPE ASSGN IN PUB 10530997
         BNE   SJCCER                                                   10530998
         BALR  SJLKRG,SJFBRG                 GET 2ND PARAMETER          10530999
         CLC   SJBUCK(2),SJKHEX              TEST FORMAT- MUST BE X'HH' 10531000
         BNE   SJCCER                                                   10531001
         CLC   SJBUCK+4(2),SJKQB                                        10531002
         BNE   SJCCER                                                   10531003
         MVC   SJBCK1(2),SJBUCK+2            INIT FOR CONVERSION ROUT   10531004
         BAL   SJLKRG,SJCVHB                 CONVERT HEX TO BINARY      10531005
* RESULT IS IN SJW2RG.THIS WILL BE THE COUNT REG IN SKIP TAPE ROUTINE   10531006
SJSKTP   SVC   0                             SKIP TAPE TO A TAPE MARK   10531007
         DC    YL2(SJTCCB)                                              10531008
         TM    SJTCCB+2,X'80'                                           10531009
         BC    8,*-4                                                    10531010
         BCT   SJW1RG,SJSKTP                 LOOP TILL COUNT OF ZERO    10531011
         B     SJREAD                        EXIT                       10531012
SJREST   BALR  SJLKRG,SJSBRG                                            10531013
         BALR  SJLKRG,SJFBRG                 GET FIRST PARAM            10531014
         BAL   SJBRRG,SJSYSR+2               CONV SYSXXX TO A DISP      10531015
SJRS1    STH   SJW4RG,12(SJCRRG)             STORE DISP IN 2 USER BYTES 10531016
         BALR  SJLKRG,SJFBRG                 GET CHECKPOINT IDENTIFIER  10531017
         CLI   SJBUCK+4,C' '                                            10531018
         BNE   SJCCER                                                   10531019
         MVC  14(4,SJCRRG),SJBUCK            STORE IDEN IN USER BYTES   10531020
         OI    SJCRJB(SJCRRG),X'08'          SET RESTART FLAG ON        10531021
         B     SJREAD                                                   10531022
SJECCB   DC    X'002080000014'          EOJ CCB                         10531023
         DC    YL2(SJECCW)                                              10531024
SJECCW   CCW   9,SJEOJM,X'20',12                                        10531025
SJTCCB   DC    X'000010000018'         TAPE CCB                         10531026
         DC    YL2(SJTCCW)                                              10531027
SJTCCW   CCW   X'3F',SJINPT,X'20',1                                     10531028
SJDCCB   DC    X'001180000014'                                          10531029
         DC    YL2(SJDCCW)                                              10531030
SJDCCW   CCW   9,SJINPT,X'20',80                                        10531031
SJCCB    DC    X'000080000004'                                          10531032
         DC    YL2(SJCCW)                                               10531033
SJCCW    CCW   2,SJINPT,X'20',80                                        10531034
SJBCK1   DS    1CL8                                                     10531035
         DS    1CL80                                                    10531036
SJINPT   DS    1CL80                                                    10531037
SJEOB    DC    YL2(SJBUCK+9)            END OF BUCKET ADDRESS           10531038
SJEOC    DC    YL2(SJINPT+70)           END OF CARD ADDRESS             10531039
SJKW3    DC    X'00000003'                                              10531040
SJK008   DC    X'0008'                                                  10531041
SJK01    DC    X'0001'                                                  10531042
SJBUCK   DS    1CL9                                                     10531043
SJKCTL   DC    C'// '                                                   10531044
SJKPAU   DC    C'PAUSE'                                                 10531045
SJKJOB   DC    C'JOB '                                                  10531046
SJDAT    DC    C' '                                                     10531047
SJKSYS   DC    C'SYS'                                                   10531048
SJKRDR   DC    C'RDR'                                                   10531049
SJKLST   DC    C'LST'                                                   10531050
SJKIPT   DC    C'IPT'                                                   10531051
SJKOPT   DC    C'OPT'                                                   10531052
SJKLOG   DC    C'LOG '                                                  10531053
SJKNLG   DC    C'NOLOG'                                                 10531054
SJPUB    DC    C'    '                  TEMP PUB ENTRY                  10531055
SJ9BLK   DC    C'         '            9 BLANKS                         10531056
SJNJCM   DC    C'0'                     MISSING CONTROL CARD MESSAGE    10531057
         DC    C'40'                       FOR NO JOB CARD              10531058
SJNDCM   DC    C'0'                     MISSING CONTROL CARD MESSAGE    10531059
         DC    C'50'                       FOR NO DATE CARD             10531060
SJMSG1   DC    C'110'                   MESSAGE FOR DUP JOB CARDS       10531061
SJMSG2   DC    C'220'                   CONTROL CARD ERROR MESS175      10531062
SJMSG3   DC    C'200'                  ERROR MESSAGE FOR NO //          10531063
SJPMSG   DC    C'703A '                      PAUSE MESSAGE              10531064
SJDTAB   DC    X'02'                    DEVICE TABLE ENTRIES            10531065
         DC    C'C1'                                                    10531066
         DC    X'06'                                                    10531067
         DC    C'L1'                                                    10531068
         DC    X'12'                                                    10531069
         DC    C'L2'                                                    10531070
         DC    X'0A'                                                    10531071
         DC    C'P1'                                                    10531072
         DC    X'04'                                                    10531073
         DC    C'P2'                                                    10531074
         DC    X'10'                                                    10531075
         DC    C'R0'                                                    10531076
         DC    X'08'                                                    10531077
         DC    C'R1'                                                    10531078
         DC    X'0A'                                                    10531079
         DC    C'R2'                                                    10531080
         DC    X'04'                                                    10531081
         DC    C'R3'                                                    10531082
         DC    X'0E'                                                    10531083
         DC    C'S1'                                                    10531084
         DC    X'00'                                                    10531085
         DC    C'T1'                                                    10531086
         DC    X'00'                                                    10531087
         DC    C'T2'                                                    10531088
SJMOTB   DC    X'1F'                    DAYS IN MONTH TABLE             10531089
SJFEB    DC    X'1C'                                                    10531090
         DC    X'1F'                                                    10531091
         DC    X'1E'                                                    10531092
         DC    X'1F'                                                    10531093
         DC    X'1E'                                                    10531094
         DC    X'1F'                                                    10531095
         DC    X'1F'                                                    10531096
         DC    X'1E'                                                    10531097
         DC    X'1F'                                                    10531098
         DC    X'1E'                                                    10531099
         DC    X'1F'                                                    10531100
SJTABL   DC    YL2(SJDATE)              CONTROL CARD TABLE              10531101
SJKDAT   DC    C'DATE '                                                 10531102
         DC    YL2(SJCONF)                                              10531103
         DC    C'CONFG'                                                 10531104
         DC    YL2(SJVOL)                                               10531105
         DC    C'VOL  '                                                 10531106
         DC    YL2(SJFILE)                                              10531107
         DC    C'FILES'                                                 10531108
         DC    YL2(SJREST)                                              10531109
         DC    C'RSTRT'                                                 10531110
         DC    YL2(SJEXEC)                                              10531111
         DC    C'EXEC '                                                 10531112
         DC    YL2(SJUPSI)                                              10531113
         DC    C'UPSI '                                                 10531114
         DC    YL2(SJASGN)                                              10531115
SJKASG   DC    C'ASSGN'                                                 10531116
SJNUMT   DC    10X'00'                                                  10531117
         DC    C'123456'                                                10531118
SJK5F0   DC    X'F0F0F0F0F0'                                            10531119
SJK50F   DC    X'0F0F0F0F0F'                                            10531120
SJK12    DC    X'F1F2'                                                  10531121
SJKUA    DC    C'UA '                                                   10531122
SJKHEX   DC    CL2'X'''                 CONSTANT X'                     10531123
SJKQB    DC    CL2''' '                 CONSTANT QUOTE-BLANK            10531124
SJKRPG   DC    C'RPG100'                                                10531125
SJKASM   DC    C'ASSEMB'                                                10531126
SJKRES   DC    C'SYSRES'                                                10531127
SJEOJM   DC    C'N EOJ 123456'                                          10531128
*                                                                       10531129
* VOL CARD PROCESSING                                                   10531130
*                                                                       10531131
SJVOL    BALR  SJLKRG,SJSBRG    SKIP BLANKS                             10531132
         BAL   SJW3RG,SJSYSC            CONVERT AND TEST SYSXXX         10531133
         BALR  SJLKRG,SJFBRG            PUT FILE NAME IN BUCKET         10531134
         CLC   SJBUCK(7),SJ9BLK        TEST BLANK FILD                  10531135
         BE    SJLER1                                                   10531136
         MVC   SJLAB(7),SJBUCK         STORE FILE NAME IN LABEL W/A     10531137
         OI    SJNOBR+1,X'F0'                                           10531138
         B     SJREAD                                                   10531139
*       TPLAB CARD INITIAL PROCESSING                                   10531140
SJVOL1   MVI   SJLAB+7,X'00'                                            10531141
         MVC   SJLAB+8(75),SJLAB+7                                      10531142
         LA    SJW3RG,SJLAB+7                                           10531143
         OI    SJLAB3+1,X'F0'                                           10531144
         CLC   SJBUCK(5),SJTLAB         TEST FOR TPLAB CD               10531145
         BC    7,SJNOLC                 BRANCH NOT EQUAL                10531146
*                                                                       10531147
* TPLAB CARD PROCESSING                                                 10531148
*                                                                       10531149
SJTLBP   NI    SJNOBR+1,X'0F'      RESRT SJNOBR SWITCH                  10531150
         BAL   SJBRRG,SJSTRG      PROCESS STRING                        10531151
         B     SJTINU                   BRANCH POINTER FOR CONTINU CARD 10531152
         BC    8,SJLNCK                 TEST FOR 0 LENGTH STRING        10531153
SJGOMO   EX    SJW2RG,SJMOV             MOVE LABEL INFOR                10531154
* CHECK -- STRING AT LEAST 49 BYTES                                     10531155
         LA    SJW3RG,0(SJW2RG,SJW3RG)  FIND LENGTH OF STRING           10531156
SJLNCK   CH    SJW3RG,SJTMIN            TEST LENGTH OF STRING           10531157
         BC    4,SJLCER                 BRANCH NEGATINE                 10531158
         BAL   SJBRRG,SJOTD             OUTPUT LABEL REC TO DISK        10531159
         B     SJREAD                   READ NEXT CARD                  10531160
*                                                                       10531161
SJMOV    MVC   0(1,SJW3RG),0(SJW4RG)    MOVE LABEL INFOR TO OUTPUT AREA 10531162
*                                                                       10531163
SJTINU   EX    SJW2RG,SJMOV                                             10531164
         LA    SJW3RG,1(SJW2RG,SJW3RG)  INCR LABEL OUTPUT AREA FILL ADR 10531165
         BAL   SJBRRG,SJRDCN            READ CONTINUATION CARD          10531166
         BAL   SJBRRG,SJSGAG            CONTINU STRING PROCESSING       10531167
         B     SJLCER                   2ND CONTINU IS ERROR            10531168
         BC    8,SJLNCK                 TEST FOR 0 LENGTH STRING        10531169
         LA    SJBRRG,1(SJW2RG,SJW3RG)  FORM HI LAB ADDR REQUIRED       10531170
         CH    SJBRRG,SJLBHI            TEST FOR ERRONEOUSLY LONG LABEL 10531171
         BC    4,SJGOMO                 BRANCH LABEL                    10531172
         B     SJLCER                   BRANCH TO ERROR                 10531173
         USING SJLAB2,SJW3RG                                            10531174
SJOTD    LH    SJW3RG,SJLCTR+2                                          10531175
         MVC   SJLAB2(83),SJLAB                                         10531176
         LA    SJW3RG,83(SJW3RG)                                        10531177
         STH   SJW3RG,SJLCTR+2                                          10531178
         DROP  SJW3RG                                                   10531179
         BR    SJBRRG                                                   10531180
SJLCTR   DC    H'0'                                                     10531181
         DC    YL2(SJLAB2)                                              10531182
SJLBKT   DC    X'E000'                                                  10531183
SJKON8   DC    H'8192'                                                  10531184
* STRING PROCESSING ROUTINE                                             10531185
*                                                                       10531186
SJSTRG   OI    SJ2QSW+1,X'F0'           MAKE SURE SWITCH RESET          10531187
         BALR  SJLKRG,SJSBRG            SKIP BLANKS                     10531188
         MVC   SJBUCK(9),SJ9BLK         BLANK SJBUCK                    10531189
         AH    0,SJK01                                                  10531190
         CLI   1(SJCCRG),X'7D'          TEST FOR ' AT START             10531191
         BC    7,SJLCER                 BRANCH NO '                     10531192
         LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10531193
         LA    SJW4RG,1(SJCCRG)         SAVE START ADDR                 10531194
SJGOON   LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10531195
         CH    SJCCRG,SJEOC             TEST FOR END OF CARD            10531196
         BC    10,SJEOCF                BRANCH NOT NEG                  10531197
         CLI   0(SJCCRG),X'7D'          TEST FOR '                      10531198
         BC    7,SJGOON                 BRANCH NOT EQUAL                10531199
SJQUOT   CLI   1(SJCCRG),X'7D'          TEST FOR 2ND '                  10531200
         BC    7,SJDID                  BRANCH NOT EQUAL                10531201
         LR    SJW2RG,SJCCRG            MOVE CARD COL INDEX             10531202
SJMVUP   BCTR  SJW2RG,0                 DECR TEMPORARY INDEX            10531203
         MVC   1(1,SJW2RG),0(SJW2RG)    MOVE 1 CHAR UP                  10531204
         CLR   SJW4RG,SJW2RG            TEST FOR LAST CHAR              10531205
         BC    10,SJMVUP                BRANCH NOT NEG                  10531206
         LA    SJW4RG,1(SJW4RG)         INCR BEGIN ADDR                 10531207
         LA    SJCCRG,2(SJCCRG)         INCR CARD COL INDEX             10531208
         B     SJGOON                   CONTINUE SCAN                   10531209
*                                                                       10531210
SJDID    LA    SJBRRG,4(SJBRRG)         INCR RETURN PAST USER EOC BRNCH 10531211
SJNDID   LR    SJW2RG,SJCCRG            FIND LENGTH-1 OF STRING         10531212
         LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10531213
         SR    SJW2RG,SJW4RG                                            10531214
         BCR   13,SJBRRG                RETURN IF LENGTH LENGTH 0       10531215
         BCTR  SJW2RG,0                                                 10531216
         BR    SJBRRG                   RETURN                          10531217
* CONTINUE SCAN ON CONTINUATION CARD                                    10531218
SJSGAG   LA    SJW4RG,1(SJCCRG)         SAVE STRING RESTART ADDR        10531219
SJ2QSW   BC    15,SJGOON                SWITCH TO NORMAL CONTINUATION   10531220
         OI    SJ2QSW+1,X'F0'           RESET SWITCH                    10531221
         B     SJQUOT                   GO TO 2ND QUOT TEST             10531222
*                                                                       10531223
SJEOCF   CLI   0(SJCCRG),X'7D'          END OF CARD OPERATIONS          10531224
         BC    7,SJNAPS                                                 10531225
         CLI   1(SJCCRG),C' '                                           10531226
         BC    8,SJDID                                                  10531227
         NI    SJ2QSW+1,X'0F'                                           10531228
         B     SJNDID                                                   10531229
*                                                                       10531230
SJNAPS   CLI   1(SJCCRG),C' '           TEST FOR CONTINUE               10531231
         BC    8,SJLCER                 BRANCH EQUAL                    10531232
SJNDEC   LR    SJW2RG,SJCCRG            FIND LENGTH-1 SO FAR            10531233
         SR    SJW2RG,SJW4RG                                            10531234
         BR    SJBRRG                                                   10531235
*                                                                       10531236
*                                                                       10531237
* READ CONTINUE CARD AND CHECK 1ST 15 COLS ARE BANK                     10531238
*                                                                       10531239
SJRDCN   BAL   SJLKRG,SJRDCD            READ CARD                       10531240
         CLI   SJINPT,C' '              TEST 1ST 15 COLS BLANK          10531241
         BNE   SJLCER                                                   10531242
         CLC   SJINPT+1(14),SJINPT                                      10531243
         BNE   SJLCER                                                   10531244
         LA    SJCCRG,SJINPT+14         LOAD CONTINUE SCAN ADDR         10531245
         BR    SJBRRG                   RETURN                          10531246
*                                                                       10531247
* SUBROUTINE -- RESET BRANCH SWITCHES                                   10531248
*                                                                       10531249
SJRRST   NI    SJNOBR+1,X'0F'        RESET NOBR SWITCHES                10531250
         BR    SJLKRG                                                   10531251
*                                                                       10531252
* NO LABEL CARD ROUTINE                                                 10531253
SJNOLC   BAL   SJLKRG,SJRRST                                            10531254
SJNLC1   NC    SJCRJB(2,SJCRRG),SJCRRS  RESET JOB CONTROL SWITCHES      10531255
         B     SJNOCC+8                 BRANCH TO NO CONTROL CARD       10531256
*ROUTINE FOR ERROR IN LABEL CARD                                        10531257
SJLCER   BAL   SJLKRG,SJRRST                                            10531258
SJLER1   NC    SJCRJB(2,SJCRRG),SJCRRS                                  10531259
         B     SJCCER                                                   10531260
* SUBROUTINE FOR SYSXXX CHECK AND CONVERSION                            10531261
SJSYSC   NI    SJNOBR+1,X'0F'   RESET SWITCHES                          10531262
         MVC   SJSAVS(2),SJCRJB(SJCRRG) SAVE JOB CONTROL BYTES          10531263
         NC    SJCRJB(2,SJCRRG),SJCRRS  RESET JOB CONTROL BYTES         10531264
         BALR  SJLKRG,SJSBRG   SKIP BLANKS                              10531265
         BAL   SJBRRG,SJSYSR   CONVERT AND CHECK                        10531266
         OI    SJNOBR+1,X'F0'     RESTORE SWITCHES                      10531267
         MVC   SJCRJB(2,SJCRRG),SJSAVS  RESTORE JOB CONTROL BYTES       10531268
         BR    SJW3RG    RETURN                                         10531269
SJMLAB   SR    SJW2RG,SJW2RG                                            10531270
         LA    SJW1RG,SJLAB2    GET WORK AREA ADD                       10531271
         LH    SJW4RG,SJLCTR+2                                          10531272
         SR    SJW4RG,SJW1RG                                            10531273
         SR    SJW3RG,SJW4RG   GET START ADD                            10531274
         MVI   0(SJW3RG),C'*'  PUT * IN FIRST POS VOL AREA              10531275
         LA    SJW3RG,1(SJW3RG)                                         10531276
SJLAB4   MVC   0(83,SJW3RG),0(SJW1RG)                                   10531277
         LA    SJW2RG,83(SJW2RG)                                        10531278
         LA    SJW1RG,83(SJW1RG)                                        10531279
         CR    SJW2RG,SJW4RG                                            10531280
         BE    SJEXQ6                                                   10531281
         LA    SJW3RG,83(SJW3RG)                                        10531282
         B     SJLAB4                                                   10531283
*  STORAGE AND CONSTANTS                                                10531284
SJLAB    DS    CL85                                                     10531285
SJTLAB   DC    CL5'TPLAB'                                               10531286
SJDECM   EQU   SJBCK1                                                   10531287
SJSAVS   DS    CL2                                                      10531288
SJTMIN   DC    YL2(SJLAB+55)                                            10531289
SJLBHI   DC    YL2(SJLAB+83)                                            10531290
SJCRRS   DC    X'8001'                                                  10531291
SJLAB2   DS    CL85                                                     10531292
         END   START                                                    10531293
         TITLE 'PHASE 1   TAPE TO CARD'                                 10531294
         START 2488                                                     10531295
STRT     BALR  15,0                                                     10531296
         USING *,15                                                     10531297
         BC    15,INPUT                                                 10531298
         ORG   *+6                                                      10531299
SORS     DC    F'1'           STARTING RECORD NUMBER                    10531300
QORS     DC    F'0'           SEQUENCING INFORMATION                    10531301
IRCLN    DC    H'80'          INPUT RECORD LENGTH                       10531302
IBKSZ    DC    H'80'          INPUT BLOCK SIZE                          10531303
ORCLN    DC    H'80'          OUTPUT RECORD LENGTH                      10531304
OBKSZ    DC    H'80'          OUTPUT BLOCK SIZE                         10531305
TPGM     DC    X'21'          PROGRAM TYPE                              10531306
TJOB     DC    X'01'          TYPE OF JOB                               10531307
FRCD     DC    X'01'          RECORD FORMAT                             10531308
DOPTN    DC    X'80'          INPUT AND OUTPUT OPTIONS                  10531309
POPTN    DC    X'00'                                                    10531310
LABSW    DC    X'00'                                                    10531311
ICU      DC    X'00'                                                    10531312
OCU      DC    X'00'                                                    10531313
IBKC     DC    F'0'                                                     10531314
OBKC     DC    F'0'                                                     10531315
LABIH    DC    C'**'                                                    10531316
LABOH    DC    C'**'                                                    10531317
LABIT    DC    X'14CE'        INITIALIZED TO INPUT HEADER END           10531318
LABOT    DC    H'0'                                                     10531319
LABOR    DC    H'0'                                                     10531320
AAST     DC    H'0'                                                     10531321
LABRTN   DC    X'1160'        INITIALIZED TO PHASE 4 END                10531322
IPA      DC    X'0C0C'                                                  10531323
OPA      DC    X'1010'                                                  10531324
INA      DC    X'132A'        INITIALIZED TO INPUT TRAILER END          10531325
INB      DC    H'0'                                                     10531326
OUTA     DC    H'0'                                                     10531327
OUTB     DC    H'0'                                                     10531328
UCLIM    DC    H'0'                                                     10531329
SWHD     DC    X'00'                                                    10531330
NOIO     DC    X'00'                                                    10531331
HEAD     DC    CL16'                '                                   10531332
         DC    CL16'                '                                   10531333
         DC    CL16'                '                                   10531334
         DC    CL16'                '                                   10531335
         DC    CL16'                '                                   10531336
         DC    CL16'                '                                   10531337
         DC    CL16'                '                                   10531338
         DC    CL16'                '                                   10531339
         DC    CL16'                '                                   10531340
DSTBL    DC    C'0123456789ABCDEF'                                      10531341
ULAB1    DC    H'0'                                                     10531342
ULAB2    DC    H'0'                                                     10531343
ULAB3    DC    H'0'                                                     10531344
ULAB4    DC    H'0'                                                     10531345
URET     DC    H'0'                                                     10531346
ULAB     DC    H'0'                                                     10531347
USW      DC    X'F0'                                                    10531348
         ORG   SORS+250                                                 10531349
*                                                                       10531350
***   CONTROL CARD INPUT                                                10531351
*                                                                       10531352
INPUT    SVC   0                                                        10531353
         DC    YL2(CCB)                                                 10531354
         TM    CCB+2,X'80'                                              10531355
         BC    8,*-4                                                    10531356
         CLC   HD1(3),CRDAR   IS CONTROL CARD                           10531357
         BC    7,LG1          NO                                        10531358
         CLI   CRDAR+3,C'U'   IS UTILITY MODIFIER CARD                  10531359
         BC    8,UTMF         YES                                       10531360
         CLC   HD2(3),CRDAR+3 IS FIELD SELECT CARD                      10531361
         BC    8,FS           YES                                       10531362
         TM    FSW,X'0F'      IS FIELD SELECT ENFORCED                  10531363
         BC    7,LG3          YES, LOG MESSAGE                          10531364
         CLC   HD3(3),CRDAR+3 IS HEADER CARD NO.1                       10531365
         BC    7,*+12         NO                                        10531366
         OI    SWHD,X'FF'     YES, SET SWHD                             10531367
         BC    15,HD                                                    10531368
         CLC   HD4(3),CRDAR+3 IS HEADER CARD NO.2                       10531369
         BC    7,*+12         NO                                        10531370
         OI    SWHD,X'FF'     YES, SET SWHD                             10531371
         BC    15,HDSD                                                  10531372
         CLC   HD5(3),CRDAR+3 IS END CARD                               10531373
         BC    7,LG6                                                    10531374
LGSW     BC    0,EOJ                                                    10531375
         SVC   1                                                        10531376
         DC    C'SYSLOD'                                                10531377
*                                                                       10531378
***   CONVERSION ROUTINE                                                10531379
*                                                                       10531380
BIN      MVC   BINC+1(1),0(6) SUPPLY ENDING CHARACTER                   10531381
         MVC   CBNN+1(1),0(6)                                           10531382
         LR    3,2            CHECK 4 DIGITS                            10531383
         LA    4,1                                                      10531384
         LA    5,3(2)                                                   10531385
         MVI   *-1,X'03'                                                10531386
LOOP     CLI   0(3),X'F0'                                               10531387
         BCR   4,8                                                      10531388
         CLI   0(3),X'F9'                                               10531389
         BCR   2,8                                                      10531390
         BXH   3,4,CBNN                                                 10531391
BINC     CLI   0(3),C','                                                10531392
         BC    8,*+14                                                   10531393
         BC    15,LOOP                                                  10531394
CBNN     CLI   0(3),C','                                                10531395
         BCR   7,8                                                      10531396
         LR    4,2                                                      10531397
         LA    2,1(3)                                                   10531398
         SR    3,4                                                      10531399
         BCTR  3,0                                                      10531400
         AH    3,N112                                                   10531401
         STC   3,*+5                                                    10531402
         PACK  TEMP(8),0(0,4) CONVERT TO BINARY                         10531403
         CVB   3,TEMP                                                   10531404
         C     3,N64K                                                   10531405
         BC    2,*+12                                                   10531406
         STH   3,0(9)                                                   10531407
         BC    15,2(6)                                                  10531408
         BCTR  2,0                                                      10531409
         BCR   15,8                                                     10531410
*                                                                       10531411
***   ERROR LOGGING ROUTINE                                             10531412
*                                                                       10531413
LG1      LA    5,MSSG1                                                  10531414
         LA    6,15                                                     10531415
         STC   6,LGMVC+1                                                10531416
         BC    15,LG                                                    10531417
LG2      LA    5,MSSG2                                                  10531418
         LA    6,38                                                     10531419
         STC   6,LGMVC+1                                                10531420
         OI    NTSW+1,X'F0'                                             10531421
         BC    15,LG                                                    10531422
LG3      LA    5,MSSG3                                                  10531423
         LA    6,24                                                     10531424
         STC   6,LGMVC+1                                                10531425
         BC    15,LG                                                    10531426
LG4      LA    5,MSSG4                                                  10531427
         LA    6,36                                                     10531428
         STC   6,LGMVC+1                                                10531429
         OI    NTSW+1,X'F0'                                             10531430
         LH    3,NOFS                                                   10531431
         AH    3,N1                                                     10531432
         STH   3,NOFS                                                   10531433
         BC    15,LG                                                    10531434
LG5      LA    5,MSSG5                                                  10531435
         LA    6,29                                                     10531436
         STC   6,LGMVC+1                                                10531437
         BC    15,LG                                                    10531438
LG6      LA    5,MSSG6                                                  10531439
         LA    6,19                                                     10531440
         STC   6,LGMVC+1                                                10531441
LG       XC    LOGAR(39),LOGAR    CLEAR PRINT AREA                      10531442
         LA    6,1(6)                                                   10531443
         STC   6,CCWL+7                                                 10531444
LGMVC    MVC   LOGAR(0),0(5)  MOVE MESSAGE TO PRINT AREA                10531445
         SVC   0             PRINT MSSG                                 10531446
         DC    YL2(CCBL)                                                10531447
         TM    CCBL+2,X'80'                                             10531448
         BC    8,*-4                                                    10531449
         OI    LGSW+1,X'F0'                                             10531450
NTSW     BC    0,NTRTN                                                  10531451
EOJ      SVC   1                                                        10531452
         DC    C'SYSEOJ'                                                10531453
NTRTN    NI    NTSW+1,X'00'                                             10531454
CKSW     BC    0,TPJOB                                                  10531455
CKSW1    BC    0,TPJBS                                                  10531456
         CLI   FSW,X'F0'                                                10531457
         BC    8,FSCK                                                   10531458
RET      LA    2,1(2)                                                   10531459
         CLI   0(2),C','                                                10531460
         BC    7,*+12                                                   10531461
         LA    2,1(2)                                                   10531462
         BC    15,SFSC+12                                               10531463
         CLI   0(2),C' '                                                10531464
         BC    7,RET                                                    10531465
         BC    15,SFS+8                                                 10531466
FSCK     LA    2,1(2)                                                   10531467
         CLI   0(2),C'/'                                                10531468
         BC    7,*+12                                                   10531469
         LA    2,1(2)                                                   10531470
         BC    15,FSIN                                                  10531471
         CLI   0(2),C' '                                                10531472
         BC    7,FSCK                                                   10531473
         BC    15,INPUT                                                 10531474
*                                                                       10531475
***   FINDING TYPE OF PROGRAM                                           10531476
*                                                                       10531477
UTMF     LA    2,CRDAR+4                                                10531478
         CLI   0(2),C' '      IS NEXT BLANK                             10531479
         BC    8,TPJBS        YES, BRANCH TO TPJBS                      10531480
         MVI   MSSG2,C'N'                                               10531481
         OI    CKSW+1,X'F0'                                             10531482
         CLI   0(2),C'C'      IS CARD INPUT                             10531483
         BC    7,*+12         NO, BRANCH TO NEXT                        10531484
         MVI   TPGM,X'10'     YES, SET TPGM                             10531485
         BC    15,OUTD                                                  10531486
         CLI   0(2),C'T'      IS TAPE INPUT                             10531487
         BC    7,*+12         NO, BRANCH TO NEXT                        10531488
         MVI   TPGM,X'20'     YES, SET TPGM                             10531489
         BC    15,OUTD                                                  10531490
         CLI   0(2),C'D'      IS DISK INPUT                             10531491
         BC    7,LG2          NO, ILLEGAL CHARACTER                     10531492
         MVI   TPGM,X'40'     YES, SET TPGM                             10531493
OUTD     CLI   1(2),C'C'      IS CARD OUTPUT                            10531494
         BC    7,*+12         NO, BRANCH TO NEXT                        10531495
         OI    TPGM,X'01'     YES, SET TPGM                             10531496
         BC    15,TPJOB                                                 10531497
         CLI   1(2),C'T'      IS TAPE OUTPUT                            10531498
         BC    7,*+12         NO, BRANCH TO NEXT                        10531499
         OI    TPGM,X'02'     YES, SET TPGM                             10531500
         BC    15,TPJOB                                                 10531501
         CLI   1(2),C'D'      IS DISK OUTPUT                            10531502
         BC    7,*+12         NO, BRANCH TO NEXT                        10531503
         OI    TPGM,X'04'     YES, SET TPGM                             10531504
         BC    15,TPJOB                                                 10531505
         CLI   1(2),C'P'      IS PRINT OUTPUT                           10531506
         BC    7,LG2          NO, ILLEGAL CHARACTER                     10531507
         OI    TPGM,X'08'     YES, SET TPGM                             10531508
*                                                                       10531509
***   FINDING TYPE OF JOB                                               10531510
*                                                                       10531511
TPJOB    NI    CKSW+1,X'00'                                             10531512
         OI    CKSW1+1,X'F0'                                            10531513
         LA    2,2(2)                                                   10531514
         CLI   0(2),C' '      IS NEXT BLANK                             10531515
         BC    7,LG2          NO, ILLEGAL FORMAT                        10531516
TPJBS    NI    CKSW1+1,X'00'                                            10531517
         MVI   MSSG2,C'T'                                               10531518
         CLI   1(2),C'T'      IS TYPE DEFINED                           10531519
         BC    7,LG2          NO, ILLEGAL FORMAT                        10531520
         MVI   MSSG2,C'J'                                               10531521
         LA    2,2(2)                                                   10531522
         CLI   0(2),C'C'      IS COPY                                   10531523
         BC    7,*+12         NO, BRANCH TO NEXT                        10531524
         MVI   TJOB,X'01'     YES, SET TJOB                             10531525
         BC    15,SFSC                                                  10531526
         CLI   0(2),C'F'      IS FIELD SELECT                           10531527
         BC    7,*+16         NO, BRANCH TO NEXT                        10531528
         MVI   TJOB,X'02'     YES, SET TJOB                             10531529
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10531530
         BC    15,SFSC                                                  10531531
         CLI   0(2),C'R'      IS REBLOCK                                10531532
         BC    7,EDD          NO, BRANCH TO NEXT                        10531533
         CLI   1(2),C'F'      IS REBLOCK AND FIELD SELECT               10531534
         BC    7,*+20         NO                                        10531535
         MVI   TJOB,X'08'     YES, SET TJOB                             10531536
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10531537
         LA    2,1(2)                                                   10531538
         BC    15,SFSC                                                  10531539
         MVI   TJOB,X'04'     SET TJOB                                  10531540
         BC    15,SFSC                                                  10531541
EDD      CLI   0(2),C'D'      IS DATA DISPLAY                           10531542
         BC    7,*+12         NO, BRANCH TO NEXT                        10531543
         MVI   TJOB,X'10'     YES, SET TJOB                             10531544
         BC    15,SFSC                                                  10531545
         CLI   0(2),C'L'      IS LIST                                   10531546
         BC    7,EB           NO, BRANCH TO EB                          10531547
         CLI   1(2),C'F'      IS LIST AND FIELD SELECT                  10531548
         BC    7,*+20         NO                                        10531549
         MVI   TJOB,X'00'     YES, SET TJOB                             10531550
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10531551
         LA    2,1(2)                                                   10531552
         BC    15,SFSC                                                  10531553
         MVI   TJOB,X'20'     SET TJOB                                  10531554
         BC    15,SFSC                                                  10531555
EB       CLI   0(2),C'B'      IS BOTH                                   10531556
         BC    7,LG2          NO, ILLEGAL FORMAT                        10531557
         CLI   1(2),C'F'      IS BOTH WITH FIELD SELECT                 10531558
         BC    7,*+20         NO                                        10531559
         MVI   TJOB,X'80'     YES, SET TJOB                             10531560
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10531561
         LA    2,1(2)                                                   10531562
         BC    15,SFSC                                                  10531563
         MVI   TJOB,X'40'     SET TJOB                                  10531564
         BC    15,SFSC                                                  10531565
*                                                                       10531566
***   ENTRANCE TO SEARCH OF PARAMETERS                                  10531567
*                                                                       10531568
SFS      CLI   1(2),C' '      IS BLANK                                  10531569
         BC    7,SFSC         NO, BRANCH TO SFSC                        10531570
         BC    0,INPUT                                                  10531571
         OI    *-3,X'F0'                                                10531572
         MVI   MSSG2,C'M'                                               10531573
         CLI   REQPA,X'07'    GOT ALL REQUIRED PARAMETERS               10531574
         BC    7,LG2          NO, ILLEGAL FORMAT                        10531575
         BC    15,INPUT       YES, READ NEXT CARD                       10531576
SFSC     CLI   1(2),C','      IS COMMA                                  10531577
         BC    7,LG2          NO, ILLEGAL FORMAT                        10531578
         LA    2,2(2)                                                   10531579
*                                                                       10531580
***   RECORD FORMAT PARAMETER                                           10531581
*                                                                       10531582
         CLI   0(2),C'F'      IS FORMAT DEFINED                         10531583
         BC    7,INF          NO, BRANCH TO INF                         10531584
         NI    FRCD,X'F0'                                               10531585
         LA    2,1(2)                                                   10531586
         OI    REQPA,X'01'    YES, MODIFY REQPA                         10531587
         MVI   MSSG2,C'F'                                               10531588
         CLI   0(2),C'F'      IS F-PARAMETER                            10531589
         BC    7,*+12         NO, BRANCH TO NEXT                        10531590
         OI    FRCD,X'01'     YES, MODIFY FRCD                          10531591
         BC    15,SFS                                                   10531592
         CLI   0(2),C'V'      IS V-PARAMETER                            10531593
         BC    7,*+12         NO, BRANCH TO NEXT                        10531594
         OI    FRCD,X'02'     YES, MODIFY FRCD                          10531595
         BC    15,SFS                                                   10531596
         CLI   0(2),C'U'      IS U-PARAMETER                            10531597
         BC    7,LG2          NO, ILLEGAL FORMAT                        10531598
         OI    FRCD,X'04'     YES, MODIFY FRCD                          10531599
         BC    15,SFS                                                   10531600
*                                                                       10531601
***   A-PARAMETER                                                       10531602
*                                                                       10531603
INF      CLC   0(3,2),HD6     IS A-PARAMETER                            10531604
         BC    7,OUTF         NO, BRANCH TO OUTF                        10531605
         OI    REQPA,X'02'    YES, MODIFY REQPA                         10531606
         MVI   MSSG2,C'A'                                               10531607
         LA    2,3(2)                                                   10531608
         TM    FRCD,X'01'     IS FIXED                                  10531609
         BC    8,LICB         NO, BRANCH TO LICB                        10531610
         CLC   0(2,2),HD7     IS 'K='                                   10531611
         BC    7,ULFT         NO, BRANCH TO ULFT                        10531612
         OI    FRCD,X'10'     YES, MODIFY FRCD                          10531613
         LA    2,2(2)                                                   10531614
         LA    8,LG2          CONVERT DIGITS TO BINARY                  10531615
         LA    9,IRCLN        AND STORE IN IRCLN                        10531616
         BAL   6,BIN                                                    10531617
         DC    C', '                                                    10531618
         CLC   0(2,2),HD8     IS 'D='                                   10531619
         BC    7,LG2          NO, ILLEGAL FORMAT                        10531620
         LA    2,2(2)                                                   10531621
         BC    15,LICB                                                  10531622
ULFT     LA    8,LG2          CONVERT DIGITS TO BINARY                  10531623
         LA    9,IRCLN        AND STORE IN IRCLN                        10531624
         BAL   6,BIN                                                    10531625
         DC    C', '                                                    10531626
LICB     LA    8,LG2          CONVERT DIGITS TO BINARY                  10531627
         LA    9,IBKSZ        AND STORE IN IBKSZ                        10531628
         MVI   LOOP-5,X'04'                                             10531629
         BAL   6,BIN                                                    10531630
         DC    C') '                                                    10531631
         TM    FRCD,X'01'     IS FIXED                                  10531632
         BC    1,*+10         YES                                       10531633
         MVC   IRCLN(2),IBKSZ NO, DEFINE INPUT RECORD LENGTH            10531634
         BCTR  2,0                                                      10531635
         BC    15,SFS                                                   10531636
*                                                                       10531637
***   B-PARAMETER                                                       10531638
*                                                                       10531639
OUTF     CLC   0(3,2),HD9     IS B-PARAMETER                            10531640
         BC    7,IPAR         NO, BRANCH TO IPAR                        10531641
         OI    REQPA,X'04'    YES, MODIFY REQPA                         10531642
         MVI   MSSG2,C'B'                                               10531643
         LA    2,3(2)                                                   10531644
         TM    FRCD,X'01'     IS FIXED                                  10531645
         BC    8,LOCB         NO, BRANCH TO LOCB                        10531646
         CLC   0(2,2),HD7     IS 'K='                                   10531647
         BC    8,LCHS         YES, BRANCH TO LCHS                       10531648
         LR    3,2                                                      10531649
         LA    4,1                                                      10531650
         LA    5,3(2)                                                   10531651
LOOP1    CLI   0(3),X'F0'                                               10531652
         BC    4,LG2                                                    10531653
         CLI   0(3),X'F9'                                               10531654
         BC    2,LG2                                                    10531655
         BXH   3,4,CBNN1                                                10531656
         CLI   0(3),C','                                                10531657
         BC    8,CNQ1                                                   10531658
         CLI   0(3),C')'                                                10531659
         BC    7,LOOP1                                                  10531660
         OI    LABSW,X'01'                                              10531661
         BC    15,LOCB                                                  10531662
CBNN1    CLI   0(3),C','                                                10531663
         BC    8,CNQ1                                                   10531664
         CLI   0(3),C')'                                                10531665
         BC    7,LG2                                                    10531666
         OI    LABSW,X'01'                                              10531667
         BC    15,LOCB                                                  10531668
CNQ1     LR    5,2                                                      10531669
         LA    2,1(3)                                                   10531670
         BCTR  3,0                                                      10531671
         SR    3,5                                                      10531672
         AH    3,N112                                                   10531673
         STC   3,*+5                                                    10531674
         PACK  TEMP(8),0(0,5)                                           10531675
         CVB   3,TEMP                                                   10531676
         STH   3,ORCLN                                                  10531677
LOCB     LA    8,LG2          CONVERT DIGITS TO BINARY                  10531678
         LA    9,OBKSZ        AND STORE IN OBKSZ                        10531679
         MVI   LOOP-5,X'04'                                             10531680
         BAL   6,BIN                                                    10531681
         DC    C') '                                                    10531682
         BCTR  2,0                                                      10531683
         TM    FRCD,X'01'                                               10531684
         BC    8,*+16                                                   10531685
         TM    LABSW,X'01'                                              10531686
         BC    1,SORL                                                   10531687
         BC    15,SFS                                                   10531688
SORL     MVC   ORCLN(2),OBKSZ YES, DEFINE OUTPUT RECORD LENGTH          10531689
         BC    15,SFS                                                   10531690
LCHS     OI    FRCD,X'20'     MODIFY FRCD                               10531691
         LA    2,2(2)                                                   10531692
         LA    8,LG2          CONVERT DIGITS TO BINARY                  10531693
         LA    9,ORCLN        AND STORE IN ORCLN                        10531694
         BAL   6,BIN                                                    10531695
         DC    C', '                                                    10531696
         CLC   0(2,2),HD8     IS 'D='                                   10531697
         BC    7,LG2          NO, ILLEGAL FORMAT                        10531698
         LA    2,2(2)                                                   10531699
         BC    15,LOCB                                                  10531700
*                                                                       10531701
***   I-PARAMETER                                                       10531702
*                                                                       10531703
IPAR     CLI   0(2),C'I'      IS I-PARAMETER                            10531704
         MVI   MSSG2,C'I'                                               10531705
         BC    7,OPAR         NO, BRANCH TO OPAR                        10531706
         NI    DOPTN,X'0F'                                              10531707
         CLI   1(2),C'1'      IS '1'                                    10531708
         BC    7,*+12         NO, BRANCH TO NEXT                        10531709
         OI    DOPTN,X'00'    YES, SET DOPTN                            10531710
         BC    15,TMIP                                                  10531711
         CLI   1(2),C'2'      IS '2'                                    10531712
         BC    8,*+12         YES                                       10531713
         CLI   1(2),C'M'      IS 'M'                                    10531714
         BC    7,*+12         NO, BRANCH TO NEXT                        10531715
         OI    DOPTN,X'10'    YES, SET DOPTN                            10531716
         BC    15,TMIP                                                  10531717
         CLI   1(2),C'U'      IS 'U'                                    10531718
         BC    7,*+12         NO, BRANCH TO NEXT                        10531719
         OI    DOPTN,X'80'    YES, SET DOPTN                            10531720
         BC    15,TMIP                                                  10531721
         CLI   1(2),C'R'      IS 'R'                                    10531722
         BC    7,*+12         NO, BRANCH TO NEXT                        10531723
         OI    DOPTN,X'40'    YES, SET DOPTN                            10531724
         BC    15,TMIP                                                  10531725
         CLI   1(2),C'N'      IS 'N'                                    10531726
         BC    7,LG2          NO, ILLEGAL FORMAT                        10531727
         OI    DOPTN,X'20'    YES, SET DOPTN                            10531728
TMIP     LA    2,1(2)                                                   10531729
         BC    15,SFS                                                   10531730
*                                                                       10531731
***   O-PARAMETER                                                       10531732
*                                                                       10531733
OPAR     CLI   0(2),C'O'      IS O-PARAMETER                            10531734
         BC    7,SPAR         NO, BRANCH TO SPAR                        10531735
         MVI   MSSG2,C'O'                                               10531736
         NI    DOPTN,X'F0'                                              10531737
         CLI   1(2),C'1'      IS '1'                                    10531738
         BC    7,*+12         NO, BRANCH TO NEXT                        10531739
         OI    DOPTN,X'00'    YES, SET DOPTN                            10531740
         BC    15,TMOP                                                  10531741
         CLI   1(2),C'2'      IS '2'                                    10531742
         BC    8,*+12                                                   10531743
         CLI   1(2),C'Y'      NO, IS 'Y'                                10531744
         BC    7,*+12         NO, BRANCH TO NEXT                        10531745
         OI    DOPTN,X'01'    YES, SET DOPTN                            10531746
         BC    15,TMOP                                                  10531747
         CLI   1(2),C'U'      IS 'U'                                    10531748
         BC    8,*+12                                                   10531749
         CLI   1(2),C'C'      NO, IS 'C'                                10531750
         BC    7,*+12         NO, BRANCH TO NEXT                        10531751
         OI    DOPTN,X'08'    YES, SET DOPTN                            10531752
         BC    15,TMOP                                                  10531753
         CLI   1(2),C'R'      IS 'R'                                    10531754
         BC    8,*+12                                                   10531755
         CLI   1(2),C'X'      NO, IS 'X'                                10531756
         BC    7,*+12         NO, BRANCH TO NEXT                        10531757
         OI    DOPTN,X'04'    YES, SET DOPTN                            10531758
         BC    15,TMOP                                                  10531759
         CLI   1(2),C'N'      IS 'N'                                    10531760
         BC    7,LG2          NO, ILLEGAL FORMAT                        10531761
         OI    DOPTN,X'02'    YES, SET DOPTN                            10531762
TMOP     LA    2,1(2)                                                   10531763
         BC    15,SFS                                                   10531764
*                                                                       10531765
***   S-PARAMETER                                                       10531766
*                                                                       10531767
SPAR     CLI   0(2),C'S'      IS S-PARAMETER                            10531768
         BC    7,PPAR         NO, BRANCH TO PPAR                        10531769
         MVI   MSSG2,C'S'                                               10531770
         NI    POPTN,X'0F'                                              10531771
         CLI   1(2),C'1'      IS '1'                                    10531772
         BC    7,*+12         NO, BRANCH TO NEXT                        10531773
         OI    POPTN,X'10'    YES, SET POPTN                            10531774
         BC    15,TMSP                                                  10531775
         CLI   1(2),C'2'      IS '2'                                    10531776
         BC    7,*+12         NO, BRANCH TO NEXT                        10531777
         OI    POPTN,X'20'    YES, SET POPTN                            10531778
         BC    15,TMSP                                                  10531779
         CLI   1(2),C'3'      IS '3'                                    10531780
         BC    7,LG2          NO, ILLEGAL FORMAT                        10531781
         OI    POPTN,X'40'    YES, SET POPTN                            10531782
TMSP     LA    2,1(2)                                                   10531783
         BC    15,SFS                                                   10531784
*                                                                       10531785
***   P-PARAMETER                                                       10531786
*                                                                       10531787
PPAR     CLI   0(2),C'P'      IS P-PARAMETER                            10531788
         BC    7,RPAR         NO, BRANCH TO RPAR                        10531789
         MVI   MSSG2,C'P'                                               10531790
         NI    POPTN,X'F0'                                              10531791
         CLI   1(2),C'Y'      IS 'Y'                                    10531792
         BC    7,*+12         NO, BRANCH TO NEXT                        10531793
         OI    POPTN,X'01'    YES, SET POPTN                            10531794
         BC    15,TMPP                                                  10531795
         CLI   1(2),C'N'      IS 'N'                                    10531796
         BC    7,LG2          NO, ILLEGAL FORMAT                        10531797
         OI    POPTN,X'02'    YES, SET POPTN                            10531798
TMPP     LA    2,1(2)                                                   10531799
         BC    15,SFS                                                   10531800
*                                                                       10531801
***   R-PARAMETER                                                       10531802
*                                                                       10531803
RPAR     CLI   0(2),C'R'     IS R-PARAMETER                             10531804
         BC    7,QPAR         NO, BRANCH TO QPAR                        10531805
         MVI   MSSG2,C'R'                                               10531806
         LA    2,1(2)         CHECK DIGITS                              10531807
         LR    3,2                                                      10531808
         LA    4,1                                                      10531809
         LA    5,7(2)                                                   10531810
LP1      CLI   0(3),X'F0'                                               10531811
         BC    4,LG2                                                    10531812
         CLI   0(3),X'F9'                                               10531813
         BC    2,LG2                                                    10531814
         BXH   3,4,CBIN1                                                10531815
         CLI   0(3),C','                                                10531816
         BC    8,CBIN1+16                                               10531817
         CLI   0(3),C' '                                                10531818
         BC    7,LP1                                                    10531819
         BC    8,CBIN1+16                                               10531820
CBIN1    CLI   0(3),C','                                                10531821
         BC    8,*+12                                                   10531822
         CLI   0(3),C' '                                                10531823
         BC    7,LG2                                                    10531824
         LR    5,2            CONVERT TO BINARY AND STORE IT TO SORS    10531825
         BCTR  3,0                                                      10531826
         LR    2,3                                                      10531827
         SR    3,5                                                      10531828
         AH    3,N112                                                   10531829
         STC   3,*+5                                                    10531830
         PACK  TEMP(8),0(0,5)                                           10531831
         CVB   3,TEMP                                                   10531832
         ST    3,SORS                                                   10531833
         BC    15,SFS                                                   10531834
*                                                                       10531835
***   Q-PARAMETER                                                       10531836
*                                                                       10531837
QPAR     CLC   0(3,2),HD11    IS Q-PARAMETER                            10531838
         MVI   MSSG2,C'U'                                               10531839
         BC    7,LG2          NO, ILLEGAL FORMAT                        10531840
         MVI   MSSG2,C'Q'                                               10531841
         LA    2,3(2)         CHECK DIGITS                              10531842
         LR    3,2                                                      10531843
         LA    4,1                                                      10531844
         LA    5,1(2)                                                   10531845
LP2      CLI   0(3),X'F0'                                               10531846
         BC    4,LG2                                                    10531847
         CLI   0(3),X'F9'                                               10531848
         BC    2,LG2                                                    10531849
         BXH   3,4,CBIN2                                                10531850
         CLI   0(3),C','                                                10531851
         BC    7,LP2                                                    10531852
         BC    8,*+12                                                   10531853
CBIN2    CLI   0(3),C','                                                10531854
         BC    7,LG2                                                    10531855
         LR    5,2            CONVERT TO BINARY AND STORE IT TO QORS    10531856
         LR    2,3                                                      10531857
         BCTR  3,0                                                      10531858
         SR    3,5                                                      10531859
         AH    3,N112                                                   10531860
         STC   3,*+5                                                    10531861
         PACK  TEMP(8),0(0,5)                                           10531862
         CVB   3,TEMP                                                   10531863
         STH   3,QORS                                                   10531864
         LA    2,1(2)         CHECK DIGITS                              10531865
         LR    3,2                                                      10531866
         LA    4,1                                                      10531867
         LA    5,1(2)                                                   10531868
LP3      CLI   0(3),X'F0'                                               10531869
         BC    4,LG2                                                    10531870
         CLI   0(3),X'F9'                                               10531871
         BC    2,LG2                                                    10531872
         BXH   3,4,CBIN3                                                10531873
         CLI   0(3),C')'                                                10531874
         BC    8,CNQ                                                    10531875
         BC    7,LP3                                                    10531876
CBIN3    CLI   0(3),C')'                                                10531877
         BC    7,LG2                                                    10531878
CNQ      LR    5,2            CONVERT TO BINARY AND STORE IT TO QORS+2  10531879
         LR    2,3                                                      10531880
         BCTR  3,0                                                      10531881
         SR    3,5                                                      10531882
         AH    3,N112                                                   10531883
         STC   3,*+5                                                    10531884
         PACK  TEMP(8),0(0,5)                                           10531885
         CVB   3,TEMP                                                   10531886
         STH   3,QORS+2                                                 10531887
         BC    15,SFS                                                   10531888
*                                                                       10531889
***   ENTRANCE TO FIELD SELECT CARD                                     10531890
*                                                                       10531891
FS       TM    FSW,X'F0'      IS FIELD SELECT POSSIBLE                  10531892
         BC    8,LG5          NO, UNNECESSARY CARD                      10531893
         LA    2,CRDAR+6                                                10531894
         BC    0,FSIN                                                   10531895
         OI    *-3,X'F0'                                                10531896
         MVI   FSW,X'F0'      CLEAR ENFORCED SWITCH                     10531897
         XC    NOFS(2),NOFS   SET NOFS ZERO                             10531898
         LA    7,NOFS+2       SET REGISTER 7                            10531899
*                                                                       10531900
***   FIELD SELECT CARD                                                 10531901
*                                                                       10531902
FSIN     LH    4,NOFS                                                   10531903
         AH    4,N1                                                     10531904
         CVD   4,TEMP                                                   10531905
         UNPK  MSSG4(3),TEMP+6(2)                                       10531906
         OI    MSSG4+2,X'F0'                                            10531907
         CLC   0(3,2),HD10    IS '(K,'                                  10531908
         BC    7,INKEY        NO, BRANCH TO INKEY                       10531909
         LA    2,3(2)         YES, SET BITS                             10531910
         MVI   0(7),X'80'                                               10531911
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10531912
         LA    9,4(7)         AND STORE IN R7+4                         10531913
         BAL   6,BIN                                                    10531914
         DC    C') '                                                    10531915
         CLI   0(2),C','      IS ','                                    10531916
         BC    7,LG4          NO, ILLEGAL FORMAT                        10531917
         LA    2,1(2)                                                   10531918
         BC    15,*+22        YES                                       10531919
INKEY    MVI   0(7),X'00'                                               10531920
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10531921
         LA    9,4(7)         AND STORE IN R7+4                         10531922
         BAL   6,BIN                                                    10531923
         DC    C', '                                                    10531924
         CLI   0(2),C'('      IS '('                                    10531925
         BC    8,FLDL         YES, BRANCH TO FLDL                       10531926
         NI    0(7),X'9F'     NO, SET BITS                              10531927
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10531928
         LA    9,10(7)        AND STORE IN R7+10                        10531929
         BAL   6,BIN                                                    10531930
         DC    C', '                                                    10531931
         XC    8(2,7),8(7)                                              10531932
         BC    15,FSOUT                                                 10531933
FLDL     CLI   1(2),C'P'      IS 'P'                                    10531934
         BC    7,UCOM         NO, BRANCH TO UCOM                        10531935
         OI    0(7),X'20'     YES, SET BIT                              10531936
         BC    15,PUCOM                                                 10531937
UCOM     CLI   1(2),C'U'      IS 'U'                                    10531938
         BC    7,XCOM         NO, BRANCH TO XCOM                        10531939
         OI    0(7),X'40'     YES, SET BIT                              10531940
PUCOM    CLI   2(2),C','      IS ','                                    10531941
         BC    7,LG4          NO, ILLEGAL FORMAT                        10531942
         LA    2,3(2)                                                   10531943
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10531944
         LA    9,8(7)         AND STORE IN R7+8                         10531945
         BAL   6,BIN                                                    10531946
         DC    C', '                                                    10531947
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10531948
         LA    9,10(7)        AND STORE IN R7+10                        10531949
         BAL   6,BIN                                                    10531950
         DC    C') '                                                    10531951
         BC    15,LFSP                                                  10531952
XCOM     CLI   1(2),C'X'      IS 'X'                                    10531953
         BC    7,LG4          NO, ILLEGAL FORMAT                        10531954
         OI    0(7),X'60'     YES, SET BIT                              10531955
         CLI   2(2),C','      IS ','                                    10531956
         BC    7,LG4          NO, ILLEGAL FORMAT                        10531957
         LA    2,3(2)                                                   10531958
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10531959
         LA    9,10(7)        AND STORE IN R7+10                        10531960
         BAL   6,BIN                                                    10531961
         DC    C') '                                                    10531962
         XC    8(2,7),8(7)                                              10531963
LFSP     CLI   0(2),C','      IS ','                                    10531964
         BC    7,LG4          NO, ILLEGAL FORMAT                        10531965
         LA    2,1(2)                                                   10531966
FSOUT    CLC   0(3,2),HD10    IS '(K,'                                  10531967
         BC    7,ONKEY        NO, BRANCH TO ONKEY                       10531968
         LA    2,3(2)                                                   10531969
         OI    0(7),X'10'     YES, SET BIT                              10531970
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10531971
         LA    9,6(7)         AND STORE IN R7+6                         10531972
         BAL   6,BIN                                                    10531973
         DC    C') '                                                    10531974
         BC    15,INOFS                                                 10531975
ONKEY    LR    3,2                                                      10531976
         LA    4,1                                                      10531977
         LA    5,3(2)                                                   10531978
LOP      CLI   0(3),X'F0'                                               10531979
         BC    4,LG4                                                    10531980
         CLI   0(3),X'F9'                                               10531981
         BC    2,LG4                                                    10531982
         BXH   3,4,CBN                                                  10531983
         CLI   0(3),C'/'                                                10531984
         BC    8,CBN+16                                                 10531985
         CLI   0(3),C' '                                                10531986
         BC    7,LOP                                                    10531987
         BC    8,CBN+16                                                 10531988
CBN      CLI   0(3),C'/'                                                10531989
         BC    8,*+12                                                   10531990
         CLI   0(3),C' '                                                10531991
         BC    7,LG4                                                    10531992
         LR    5,2                                                      10531993
         LR    2,3                                                      10531994
         BCTR  3,0                                                      10531995
         SR    3,5                                                      10531996
         AH    3,N112                                                   10531997
         STC   3,*+5                                                    10531998
         PACK  TEMP(8),0(0,5)                                           10531999
         CVB   3,TEMP                                                   10532000
         STH   3,6(7)                                                   10532001
INOFS    LH    3,NOFS         INCREASE NOFS BY 1                        10532002
         AH    3,N1                                                     10532003
         STH   3,NOFS                                                   10532004
         TM    0(7),X'10'     IS KEY SPECIFIED                          10532005
         AH    7,N12          INCREASE REGISTER 7 BY 12                 10532006
         BC    8,CONT         NO                                        10532007
         CLI   0(2),C'/'      IS '/'                                    10532008
         BC    7,*+12         NO                                        10532009
         LA    2,1(2)                                                   10532010
         BC    15,FSIN        YES, BRANCH TO FSIN                       10532011
         CLI   0(2),C' '      IS BLANK                                  10532012
         BC    7,LG4          NO, ILLEGAL FORMAT                        10532013
         BC    15,INPUT       YES, READ NEXT CARD                       10532014
CONT     CLI   1(2),C'/'      IS '/'                                    10532015
         BCTR  2,0                                                      10532016
         BC    7,INPUT        NO, READ NEXT CARD                        10532017
         LA    2,2(2)                                                   10532018
         BC    15,FSIN                                                  10532019
*                                                                       10532020
***   HEADER CARD                                                       10532021
*                                                                       10532022
HD       MVC   HEAD(74),CRDAR+6    STORE HEADING LINE                   10532023
         BC    15,INPUT                                                 10532024
HDSD     MVC   HEAD+74(70),CRDAR+6 STORE HEADING LINE                   10532025
         BC    15,INPUT                                                 10532026
*                                                                       10532027
***   CONSTANT                                                          10532028
*                                                                       10532029
         CNOP  0,8                                                      10532030
CCB      DC    F'0'                                                     10532031
         DC    X'0004'                                                  10532032
         DC    YL2(CCW)                                                 10532033
CCW      DC    X'02'                                                    10532034
         DC    AL3(CRDAR)                                               10532035
         DC    X'00000050'                                              10532036
CCBL     DC    F'0'                                                     10532037
         DC    X'0014'                                                  10532038
         DC    YL2(CCWL)                                                10532039
CCWL     DC    X'09'                                                    10532040
         DC    AL3(LOGAR)                                               10532041
         DC    X'00000050'                                              10532042
TEMP     DS    D                                                        10532043
N64K     DC    X'0000FFFF'                                              10532044
N1       DC    X'0001'                                                  10532045
N12      DC    X'000C'                                                  10532046
N112     DC    X'0070'                                                  10532047
CRDAR    DS    CL80                                                     10532048
         DC    C' '                                                     10532049
LOGAR    DS    CL39                                                     10532050
FSW      DC    X'00'                                                    10532051
REQPA    DC    X'00'                                                    10532052
HD1      DC    CL3'// '                                                 10532053
HD2      DC    CL3'FS '                                                 10532054
HD3      DC    CL3'H1 '                                                 10532055
HD4      DC    CL3'H2 '                                                 10532056
HD5      DC    CL3'END'                                                 10532057
HD6      DC    CL3'A=('                                                 10532058
HD7      DC    CL2'K='                                                  10532059
HD8      DC    CL2'D='                                                  10532060
HD9      DC    CL3'B=('                                                 10532061
HD10     DC    CL3'(K,'                                                 10532062
HD11     DC    CL3'Q=('                                                 10532063
MSSG1    DC    C'END CARD MISSING'                                      10532064
MSSG2    DC    C'  ILLEGAL FORMAT'                                      10532065
         DC    C'. UTILITY MODIFI'                                      10532066
         DC    C'ER CARD'                                               10532067
MSSG3    DC    C'FIELD SELECT CAR'                                      10532068
         DC    C'D MISSING'                                             10532069
MSSG4    DC    C'    ILLEGAL FORM'                                      10532070
         DC    C'AT. FIELD SELECT'                                      10532071
         DC    C' CARD'                                                 10532072
MSSG5    DC    C'FIELD SELECT CAR'                                      10532073
         DC    C'D NOT EXPECTED'                                        10532074
MSSG6    DC    C'INVALID CONTROL '                                      10532075
         DC    C'CARD'                                                  10532076
         ORG   SORS+4078                                                10532077
NOFS     DS    H                                                        10532078
         END   STRT                                                     10532079
         TITLE 'PHASE 2   TAPE TO CARD'                                 10532080
STAR     START 2752                                                     10532081
START    BALR  15,0                                                     10532082
         USING *,15                                                     10532083
*                                                                       10532084
**** TAPE TO CARD                                                       10532085
*                                                                       10532086
SORS     EQU   2500                                                     10532087
QORS     EQU   2504                                                     10532088
IRCLN    EQU   2508                                                     10532089
IBKSZ    EQU   2510                                                     10532090
ORCLN    EQU   2512                                                     10532091
OBKSZ    EQU   2514                                                     10532092
TPGM     EQU   2516                                                     10532093
TJOB     EQU   2517                                                     10532094
FRCD     EQU   2518                                                     10532095
DOPTN    EQU   2519                                                     10532096
POPTN    EQU   2520                                                     10532097
LABSW    EQU   2521                                                     10532098
ICU      EQU   2522                                                     10532099
OCU      EQU   2523                                                     10532100
IBKC     EQU   2524                                                     10532101
OBKC     EQU   2528                                                     10532102
LABIH    EQU   2532                                                     10532103
LABOH    EQU   2534                                                     10532104
LABIT    EQU   2536                                                     10532105
LABOT    EQU   2538                                                     10532106
LABOR    EQU   2540                                                     10532107
AAST     EQU   2542                                                     10532108
LABRTN   EQU   2544                                                     10532109
IPA      EQU   2546                                                     10532110
OPA      EQU   2548                                                     10532111
INA      EQU   2550                                                     10532112
INB      EQU   2552                                                     10532113
OUTA     EQU   2554                                                     10532114
OUTB     EQU   2556                                                     10532115
UCLIM    EQU   2558                                                     10532116
SWHD     EQU   2560                                                     10532117
NOIO     EQU   2561                                                     10532118
DSTBL    EQU   2706                                                     10532119
*                                                                       10532120
***      MAIN LINE DIAGNOSTIC ROUTINE                                   10532121
*                                                                       10532122
FIRSTY   LA    8,ERRTN                                                  10532123
         LA    7,ER00                                                   10532124
         BALR  14,8                                                     10532125
         LH    11,ZERO                  ZERO ERROR COUNTER              10532126
         TM    LABSW,X'01'             IS THERE A UTIL CARD ERROR       10532127
         BC    8,*+10                  NO                               10532128
         LA    7,ER3                                                    10532129
         BALR  14,8                                                     10532130
         LH    1,20                    COMMUNICATION REG ADDRESS        10532131
         SR    2,2                     ZERO REG 2                       10532132
         IC    2,9(1)                  GET CONFG BYTE                   10532133
         SRL   2,5                                                      10532134
         LH    1,ATEK                                                   10532135
         SLL   1,0(2)                  AMOUNT OF CORE AVAILABLE         10532136
         SH    1,ONE                                                    10532137
         TM    0(1),X'5C'              ASTERISK  IF YES NO LABELS       10532138
         BC    1,SUBT                                                   10532139
         OI    LABSW,X'20'             SET LABEL ECIST SWITCH           10532140
REPEAT   SH    1,ATEY3                 POINT TO THE NEXT LOCATI         10532141
         TM    0(1),X'5C'              IS IT AN ASTERISK                10532142
         BC    12,REPEAT                                                10532143
SUBT     STH   1,AAST                  STORE THE ASTERISK ADDRE         10532144
         STC   1,ER00                  TEST FOR HALF WORD ALIGNMENT     10532145
         TM    ER00,X'01'              IS IT ODD ALIGNMENT              10532146
         BC    8,SUBTRT                                                 10532147
         SH    1,ONE                   ALLIGN ON A  AHLF WORD BOUNDARY  10532148
SUBTRT   SH    1,TWO                   SUBT INST LENGTH                 10532149
         MVC   0(2,1),BRANCH           MOVE   BRANCH TO PHASE 4         10532150
         STH   1,UCLIM                 STORE ADDRESS                    10532151
AA       TM    TPGM,X'21'              TAPE TO CARD                     10532152
         BC    1,A1                                                     10532153
         LA    7,ER0                    LOAD  ADDRESS                   10532154
         BALR  14,8                    GO TO ERROR ROUTINE              10532155
A1       LH    1,22                     REG 1 CONTAINS THE PUB ADDRESS  10532156
         TM    3(1),X'FF'              MORE THAN 1 TAPE UNIT            10532157
ZETA     BC    5,EXTRA                 FOR INPUT                        10532158
         TM    14(1),X'FF'             TAPE INPUT                       10532159
         BC    8,A2                                                     10532160
         LA    7,ER1                    LOAD  ADDRESS                   10532161
         BALR  14,8                    GO TO ERROR ROUTINE              10532162
A2       CLI   18(1),X'0A'             SYSOPT PUNCH 1402                10532163
         BC    8,A3                                                     10532164
         CLI   18(1),X'04'             SYSOPT 1442,2520,2501            10532165
         BC    8,A3                                                     10532166
         LA    7,ER2                    LOAD  ADDRESS                   10532167
         BALR  14,8                    GO TO ERROR ROUTINE              10532168
A3       TM    FRCD,X'01'               FIXED LENGTH INPUT              10532169
         BC    1,A4                                                     10532170
         LA    7,ER5                    LOAD  ADDRESS                   10532171
         BALR  14,8                    GO TO ERROR ROUTINE              10532172
A4       TM    TJOB,X'0F'               TYPE C,F,RF,OR R                10532173
         BC    4,A5                                                     10532174
         OI    SWIT,X'20'              SET INVALID PROG TYPE SWIT       10532175
         LA    7,ER6                    LOAD  ADDRESS                   10532176
         BALR  14,8                    GO TO ERROR ROUTINE              10532177
A5       TM    DOPTN,X'F0'             TAPE INPUT OPTION VALID          10532178
         BC    4,A6                                                     10532179
         OI    SWIT,X'02'              INVALID INPUT  OPTION            10532180
         LA    7,ER11                   LOAD  ADDRESS                   10532181
         BALR  14,8                    GO TO ERROR ROUTINE              10532182
A6       TM    DOPTN,X'0E'             CARD OUTPUT OPTION VALID         10532183
         BC    8,A7                                                     10532184
         OI    SWIT,X'08'              INVALID OUTPUT OPTION            10532185
         LA    7,ER12                   LOAD  ADDRESS                   10532186
         BALR  14,8                    GO TO ERROR ROUTINE              10532187
A7       TM    DOPTN,X'01'             OUTPUT BINARY                    10532188
         BC    8,BCD                                                    10532189
A8       LH    1,ORCLN                 ORL GREATER THAN 160             10532190
         CH    1,ONE60                                                  10532191
         BC    13,A9                                                    10532192
         LA    7,ER9                    LOAD  ADDRESS                   10532193
         BALR  14,8                    GO TO ERROR ROUTINE              10532194
A9       BC    15,A13                                                   10532195
OUTPUT   LH    1,IRCLN                 IRL GREATER THAN 4096            10532196
         CH    1,FOR096                                                 10532197
         BC    13,A10                                                   10532198
         LA    7,ER7                    LOAD  ADDRESS                   10532199
         BALR  14,8                    GO TO ERROR ROUTINE              10532200
A10      LH    3,IBKSZ                 IBL EQUAT TO K(IRL)              10532201
         N     3,ANDOP                                                  10532202
         SR    2,2                     ZERO REG 2                       10532203
         LH    4,IRCLN                 PUT IRCLN IN REG 4               10532204
         DR    2,4                     DIVIDE                           10532205
         LTR   2,2                     IS THERE A REMAINDER             10532206
       BC      8,A11                                                    10532207
         LA    7,ER8                    LOAD  ADDRESS                   10532208
         BALR  14,8                    GO TO ERROR ROUTINE              10532209
A11      LH    1,QORS+2                 CARD SEQ PARA VALID             10532210
         CH    1,TEN                    6 GREATER THAN 10               10532211
         BC    13,A12                                                   10532212
         LA    7,ER13                   LOAD  ADDRESS                   10532213
         BALR  14,8                    GO TO ERROR ROUTINE              10532214
A12      AH    1,QORS                   ADD A TO B                      10532215
         BCTR  1,0                                                      10532216
         CH    1,EIGHTY                                                 10532217
         BC    13,A14                                                   10532218
         LA    7,ER13                                                   10532219
         BALR  14,8                    GO TO ERROR ROUTINE              10532220
         BC    15,A14                                                   10532221
BCD      LH    1,ORCLN                 ORL GREATER THAN 80              10532222
         CH    1,EIGHTY                                                 10532223
         BC    13,A13                                                   10532224
         LA    7,ER9                                                    10532225
         BALR  14,8                    GO TO ERROR ROUTINE              10532226
A13      CLC   OBKSZ(2),ORCLN                                           10532227
         BC    8,OUTPUT                                                 10532228
         LA    7,ER10                                                   10532229
         BALR  14,8                    GO TO ERROR ROUTINE              10532230
         BC    15,OUTPUT                                                10532231
A14      LH    6,IRCLN                 IF IRL NOT EQUAL ORL, THEN       10532232
         CH    6,ORCLN                 MUST FIELD SELECT                10532233
         BC    8,RP                                                     10532234
         TM    TJOB,X'0A'                                               10532235
         BC    4,RP                                                     10532236
         LA    7,ER26                                                   10532237
         BALR  14,8                                                     10532238
         BC    15,RP                                                    10532239
ERRTN    MVC   ER00(36),0(7)           MOVE MESSAGE TO PRINT AREA       10532240
         AH    11,ONE                   ADD 1 TO ERROR COUNTER          10532241
         SH    7,ONE                                                    10532242
         MVC   COM+7(1),0(7)           MOVE LENGTH TO BE PRINTED        10532243
         SVC   0                                                        10532244
         DC    YL2(CCB)                                                 10532245
         TM    CCB+2,X'80'              WRITE FINISHED                  10532246
         BC    8,*-4                                                    10532247
         BCR   15,14                                                    10532248
EXTRA    CLC   25(2,1),ZERO            IS THE UNIT ASSIGNED             10532249
         BC    8,ZETA+4                                                 10532250
         MVI   IPA+1,X'18'             MOVE ALTERNATE INPUT DEVICE DSP  10532251
         TM    26(1),X'FF'                                              10532252
         BC    8,ZETA+4                YES                              10532253
         LA    7,ER1                   NON TAPE UNIT MESSAGE            10532254
         BALR  14,8                                                     10532255
         BC    15,ZETA+4                                                10532256
*                                                                       10532257
***      MAIN LINE CONTROL                                              10532258
*                                                                       10532259
RP       LH    9,UCLIM                                                  10532260
         LH    0,ZERO                  ZERO REG ZERO                    10532261
         SR    1,1                                                      10532262
         SR    10,10                                                    10532263
RP1      TM    TJOB,X'0A'               REBLOCK AND /OR FIELD SELECT    10532264
         BC    9,REBL                                                   10532265
         LH    0,NOFS                                                   10532266
***  THIS REGISRER IS USED TO NUMBER THE FIELD SELECT ERROR MESSAGES    10532267
         LR    10,0                    GET CURRENT FS CARD ENTRY FROM   10532268
         LA    10,1(10)                ADD ONE TO REG 10                10532269
         LR    1,0                     GET THE NUMBER OF FS ENTRIES     10532270
         BCTR  1,0                                                      10532271
         MH    1,TWELVE                POINT TO THE LAST ONE            10532272
RP2      SH    0,ONE                                                    10532273
         BCTR  10,0                    POINT TO THE NEXT ENTRY          10532274
RP3      LA    7,NOFS+2(1)                                              10532275
         TM    0(7),X'60'              PACK OR UNPACK                   10532276
         BC    4,CC                    GO MODIFY REGS FOR DIAGNOSTICS   10532277
         BC    1,WRONG                                                  10532278
         MVC   ER16+32(4),ER43         MOVE FS TO ERROR MESSAGE         10532279
         MVC   ER31+4(4),ER43                                           10532280
         L     4,NOFS+10(1)                4          B                 10532281
         LR    6,4                                                      10532282
ZUTI     LH    2,NOFS+6(1)             REG 2 CONTAINS A                 10532283
         LH    3,NOFS+8(1)                  3          C                10532284
         BCTR  2,0                                                      10532285
         BCTR  3,0                                                      10532286
         LTR   4,4                     N EQUAL ZERO TEST                10532287
         BC    8,UDOPE                                                  10532288
         LR    5,2                          5          A                10532289
         LR    7,3                          7          C                10532290
         AR    5,4                          5          A+B              10532291
         AR    7,6                         7         C+B(M)             10532292
         CH    5,IRCLN                  A+B GREATER INPUT REC LENGTH    10532293
         BC    2,ERRORA                                                 10532294
         CH    7,ORCLN                  C+B         OUTPUT              10532295
         BC    2,ERRORA                                                 10532296
         LA    2,1(2)                                                   10532297
         LA    3,1(3)                                                   10532298
          LA    7,NOFS+2(1)                                             10532299
         TM    0(7),X'60'              PACK OR UNPACK                   10532300
         BC    4,BB                    GO TO PACK OR UNPACK             10532301
         BAL   14,GG                                                    10532302
         BC    15,L                                                     10532303
L        CH    0,ZERO                  ALL FIELD SELECT PATAMETERS      10532304
         BC    2,ADER                                                   10532305
Q        STH   9,UCLIM                  STORE ADDR IN UTIL COMM TAB     10532306
         TM    ICU,X'FF'               DID USER SUPPLY OWN LABELS       10532307
         BC    12,MAXIY                NO                               10532308
LABEL    SH    9,LABRTN                                                 10532309
         MVC   CHANGE+6(2),*-2         MOVE LAST ADDR ADDRESS TO ASSGN  10532310
         BC    15,MAXY                                                  10532311
MAXIY    TM    LABSW,X'20'             IS THERE LABEL CHECKING          10532312
         BC    8,LABEL                                                  10532313
         TM    DOPTN,X'10'             YES - MULTIPLE REEL FILES        10532314
         BC    1,*+18                  YES                              10532315
         SH    9,INA                   SUBT LAST ADDR OF IPT TRAIL LAB  10532316
         MVC   CHANGE+6(2),*-2         MOVE LAST ADDR ADDRESS TO ASSGN  10532317
         BC    15,MAXY                                                  10532318
         SH    9,LABIT                 SUBT ADDR OF PH3 IN LABEL RTN    10532319
         MVC   CHANGE+6(2),*-2         MOVE LAST ADDR ADDRESS TO ASSGN  10532320
MAXY     STH   9,MAXIO                 STORE AVAILABLE CORE FOR I/O     10532321
         TM    TJOB,X'01'               TYPE COPY                       10532322
         BC    1,ASSIGN                                                 10532323
         MVI   CHANGE+1,X'80'                                           10532324
         BC    15,ASSIGN                                                10532325
ADER     SH    1,TWELVE                                                 10532326
         BC    15,RP2                                                   10532327
REBL     TM    TJOB,X'04'                                               10532328
         BC    8,Q                                                      10532329
         LH    4,IRCLN                                                  10532330
         LH    2,ONE                                                    10532331
         LH    3,ONE                                                    10532332
         BAL   14,GG                                                    10532333
         BC    15,Q                                                     10532334
ERRORA   LA    7,ER16                                                   10532335
         BAL   14,CVD                                                   10532336
         UNPK  ER16(3),OUTARA(8)                                        10532337
         BALR  14,8                    GO TO ERROR ROUTINE              10532338
         BC    15,L                                                     10532339
CC       LH    4,NOFS+10(1)            REG 4 CONTAINS N                 10532340
         LH    6,NOFS+12(1)                6          M                 10532341
         TM    0(7),X'40'                                               10532342
         BC    1,UNPKR                                                  10532343
         MVC   ER16+32(4),ER45         MOVE PACK TO ERROR MESSAGE       10532344
         MVC   ER31+4(4),ER45                                           10532345
         BC    15,ZUTI                                                  10532346
UNPKR    MVC   ER16+32(4),ER44         MOVE UNPK TO ERROR MESSAGE       10532347
         MVC   ER31+4(4),ER44                                           10532348
         BC    15,ZUTI                                                  10532349
UDOPE    LA    7,ER31                  N EQUALS ZERO                    10532350
         BAL   14,CVD                                                   10532351
         UNPK  ER31(3),OUTARA(8)                                        10532352
         BALR  14,8                                                     10532353
         BC    15,L                                                     10532354
WRONG    LA    7,ERWR                                                   10532355
         BAL    14,CVD                                                  10532356
         UNPK  ERWR(3),OUTARA(8)                                        10532357
         BALR  14,8                                                     10532358
         BC    15,L                                                     10532359
*                                                                       10532360
***    GENERATE ROUTINE FOR FIELD SELECT AND REBLOCKING                 10532361
*                                                                       10532362
GG       LH    5,TWO56                 REG 5 CONTAINS 256               10532363
         LR    7,5                          7          255              10532364
         SH    7,ONE                                                    10532365
         AH    2,XSIX                       2          A AND REG 6      10532366
         AH    3,XTEN                       3          C AND REG 10     10532367
         BCTR  2,0                                                      10532368
         BCTR  3,0                                                      10532369
BACK     CR    4,5                      B LESS OR EQUAL TO 256          10532370
         BC    12,LAST                                                  10532371
         STH   2,MOVE+4                 NO - STORE A AND C              10532372
         STH   3,MOVE+2                                                 10532373
         AR    2,5                      ADD 256 TO A AND C              10532374
         AR    3,5                                                      10532375
         STC   7,MOVE+1                 STORE 255 IN DUMMY INST         10532376
         SR    4,5                      SUBT  256 FROM B                10532377
         SH    9,SIX                   SUBT INST LENGTH                 10532378
         MVC   0(6,9),MOVE             MOVE INST TO UPPER CORE          10532379
         BC    15,BACK                                                  10532380
LAST     STH   2,MOVE+4                GENERATE LAST MOVE               10532381
         STH   3,MOVE+2                                                 10532382
         SH    4,ONE                   SUBT ONE FROM B                  10532383
         STC   4,MOVE+1                                                 10532384
         SH    9,SIX                   SUBT INST LENGTH                 10532385
         MVC   0(6,9),MOVE             MOVE INST TO UPPER CORE          10532386
         BCR   15,14                    RETURN                          10532387
*                                                                       10532388
***      UNPACK ROUTINE                                                 10532389
*                                                                       10532390
Z        LH    2,NOFS+6(1)              REG 2 CONTAINS A                10532391
         LH    3,NOFS+8(1)                  3          C                10532392
         LH    4,NOFS+10(1)                 4          N                10532393
         LH    5,NOFS+12(1)                 5          M                10532394
         AH    2,XSIX                       2          A AND REG 6      10532395
         AH    3,XTEN                       3          C AND REG 10     10532396
         SH    2,ONE                     SUBT 1,1 FROM A,C              10532397
         SH    3,ONE                                                    10532398
         STH   2,UNPK2+4                 STORE A,C IN UNPACK2           10532399
         STH   3,UNPK2+2                                                10532400
         STH   3,MVI+2                                                  10532401
         STH   3,MVC+4                                                  10532402
         AH    3,ONE                                                    10532403
         STH   3,MVC+2                                                  10532404
         SH    3,ONE                                                    10532405
         CH    4,EIGHT                  N LESS OR EQUAL TO 8            10532406
         BC    12,LES                                                   10532407
         AR    2,4                      A AND C NOW POINT TO THE LAST   10532408
         AR    3,5                      BYTE +1 OF THEIR AREAS          10532409
         SH    2,ONE                     SUBT 1,1 FROM A,C              10532410
         SH    3,ONE                                                    10532411
ALPHA    CH    4,EIGHT                  N LESS OR EQUAL TO 8            10532412
         BC    12,LES                                                   10532413
         SH    2,SEVEN                                                  10532414
         SH    3,FORTEN                  SUBT 7,14 FROM A,C , N,M       10532415
         SH    4,SEVEN                                                  10532416
         SH    5,FORTEN                                                 10532417
         STH   2,UNPK1+4                                                10532418
         STH   3,UNPK1+2                                                10532419
         SH    9,SIX                    MOVE TO                         10532420
         MVC   0(6,9),UNPK1             UPPER CORE                      10532421
         BC    15,ALPHA                                                 10532422
LES      CH    5,ONE                   M LESS THAN ONE                  10532423
         BC    4,ERRO                                                   10532424
         CH    5,SIXTEN                M GREATER THAN 16                10532425
         BC    12,GEBER1                                                10532426
         CH    5,TWO56                 M GREATER THAN 256               10532427
         BC    2,ERRO                                                   10532428
         SH    5,ONE                   SUBT ONE FROM M                  10532429
         STC   5,MVC+1                   STORE LENGTH                   10532430
         SH    3,FORTEN                  SUBT 14 FROM C                 10532431
         STH   3,UNPK2+2               STORE C AND REGS IN INST         10532432
         SH    4,ONE                   SUBT ONE FROM N                  10532433
         STC   4,UNPK2+1                 STORE N                        10532434
         MVZ   UNPK2+1(1),UNPK1+1      STORE M IN LENGTH                10532435
         SH    9,SIXTEN                  SUBT INST LENGTH               10532436
         MVC   0(16,9),MVI               MOVE TO UPPER CORE             10532437
         STH   9,UCLIM                 STORE UPPER CORE LIMIT           10532438
         BC    15,L                                                     10532439
GEBER1   SH    4,ONE                   SUBT ONE FROM(N,M)               10532440
         SH    5,ONE                                                    10532441
ASTER    SLA   5,4                      GET ONE BYTE LENGTH MIN         10532442
         AR    5,4                                                      10532443
         STC   5,UNPK2+1                LENGTH IS STORED                10532444
         SH    9,SIX                                                    10532445
         MVC   0(6,9),UNPK2                                             10532446
         BC    15,L                                                     10532447
*                                                                       10532448
***      PACK ROUTINE                                                   10532449
*                                                                       10532450
BB       LA    7,NOFS+2(1)             MOVE ADDRESS OF TYPE INTO REG 7  10532451
         TM    0(7),X'20'              IS IT PACK                       10532452
         BC    8,Z                                                      10532453
         LH    2,NOFS+6(1)              REG 2 CONTAINS A                10532454
         LH    3,NOFS+8(1)                  3          C                10532455
         LH    4,NOFS+10(1)                 4          N                10532456
         LH    5,NOFS+12(1)                 5          M                10532457
         AH    2,XSIX                       2          A AND REG 6      10532458
         AH    3,XTEN                       3          C         10     10532459
         SH    2,ONE                   SUBT 1,1 FROM A,C                10532460
         SH    3,ONE                                                    10532461
         STH   2,PACK2+4               STORE A AND REGS IN PACK         10532462
         STH   3,PACK2+2                                                10532463
         STH   3,XCL+2                 STORE C AND REGS IN PACK AND XC  10532464
         STH   3,XCL+4                                                  10532465
         CH    4,SIXTEN                 N LESS OR EQUAL TO 16           10532466
         BC    12,LES2                                                  10532467
         AR    2,4                     ADD N-1,M-1 TO A,C               10532468
         AR    3,5                                                      10532469
         SH    2,ONE                   SUBT U,1 FROM A,C                10532470
         SH    3,ONE                                                    10532471
BETA     CH    4,SIXTEN                 N LESS OR EQUAL TO 16           10532472
         BC    12,LES2                                                  10532473
         SH    2,FORTEN                SUBT 14,7 FROM A,C               10532474
         SH    3,SEVEN                                                  10532475
         STH   2,PACK1+4               A AND C IN INSTRUCTION           10532476
         STH   3,PACK1+2                                                10532477
         SH    4,FORTEN                 SUBT(14,7) FROM (A,C)AND (N,M)  10532478
         SH    5,SEVEN                                                  10532479
         SH    9,SIX                    SUBT INST LENGTH                10532480
         MVC   0(6,9),PACK1            MOVE TO UPPER CORE               10532481
         BC    15,BETA                                                  10532482
LES2     CH    5,ONE                   M LESS THAN 2                    10532483
         BC    4,ERRO1                                                  10532484
         CH    5,SIXTEN                M GREZTER THAN 16                10532485
         BC    12,GEBER                                                 10532486
         CH    5,TWO56                 M GREATER THAN 256               10532487
         BC    2,ERRO1                                                  10532488
         SH    5,ONE                   SUBT ONE FROM M                  10532489
         STC   5,XCL+1                 STORE LENGTH IN EXCLUSIVE OR     10532490
         SH    3,FORTEN                SUBT 14 FROM C AND REGS          10532491
         STH   3,PACK2+2                                                10532492
         SH    4,ONE                   SUBT ONE FROM N                  10532493
         STC   4,PACK2+1               STORE N-1                        10532494
         MVZ   PACK2+1(1),KONST        PUT 15 UN INST LENGTH            10532495
         SH    9,TWELVE                SUBT INST LENGTH                 10532496
         MVC   0(12,9),XCL             MOVE INSTRUCTIONS TO UPPER CORE  10532497
         BC    15,L                                                     10532498
GEBER    SH    4,ONE                   SUBT 1,1 FROM N,M                10532499
         SH    5,ONE                    GET 1 BYTE LENGTH               10532500
         SLA   5,4                      AND                             10532501
         AR    5,4                      STORE                           10532502
         STC   5,PACK2+1                                                10532503
         SH    9,SIX                    SUBT INST LENGTH                10532504
         MVC   0(6,9),PACK2             MOVE TO UPPER CORE              10532505
         BC    15,L                                                     10532506
*                                                                       10532507
***     ASSIGN  IO  AREAS                                               10532508
*                                                                       10532509
ASSIGN   OI    SWIT,X'01'                                               10532510
         TM    TJOB,X'01'              JOB COPY                         10532511
         BC    8,COPYER                                                 10532512
         CLC   IBKSZ(2),OBKSZ          BLOCK SIZES EQUAL                10532513
         BC    8,COPYER                                                 10532514
         OI    SWIT,X'04'              SUPRESS I/O PIRNT SWITCH         10532515
         LA    7,ER10                  INVALID OUTPUT BLOCK LENGTH      10532516
         BALR  14,8                                                     10532517
         BC    15,GOERT                                                 10532518
COPYER   EQU   *                                                        10532519
         LH    2,TWO                                                    10532520
         LH    1,MAXIO                 A EQUALS 2,IO LIMIT IS IN REG 1  10532521
         N     1,ANDOP                 GET RID OF MINUS PROROGATION     10532522
         LR    3,2                          B=2                         10532523
         LH    10,OBKSZ                                                 10532524
         LH    9,IBKSZ                 GET INKSZ IN REG 9               10532525
         N     10,ANDOP                                                 10532526
         N     9,ANDOP                 GET RID OF MINUS                 10532527
RETURN   LR    7,3                                                      10532528
         LR    5,2                                                      10532529
         MR    6,10                                                     10532530
         MR    4,9                                                      10532531
         AR    5,7                                                      10532532
         CR    5,1                                                      10532533
         BC    12,ASGN                 ASSIGN AREAS IF POSSIBLE         10532534
TEST     TM    SWIT,X'01'                   SWITCH ON TEST              10532535
         BC    1,ON                                                     10532536
         OI    SWIT,X'01'                   TURN SWITCH ON              10532537
         SH    3,ONE                   SUBT ONE FROM B                  10532538
         AH    2,ONE                   ADD ONE TO A                     10532539
         LTR   3,3                     B LESS THAN ZERO TEST            10532540
         BC    4,ERROR                      YES                         10532541
         BC    15,RETURN                    NO                          10532542
ON       NI    SWIT,X'FE'                   TURN SWITCH OFF             10532543
         SH    2,ONE                   SUBT ONE FROM A                  10532544
         BC    15,RETURN                                                10532545
ERROR    LA    8,ERRTN                                                  10532546
         LA    7,ER14                   LOAD  ADDRESS                   10532547
         OI    SWIT,X'04'              SET SUPRESS I/O PRINT SWITCH     10532548
         BALR  14,8                    GO TO ERROR ROUTINE              10532549
GOERT    STH   11,FOR096               STORE NUMBER OF ERRORS           10532550
         BC    15,ENDLOG                                                10532551
*                                                                       10532552
***   ACTUAL ASSIGNING OF INPUT OUTPUT AREAS                            10532553
*                                                                       10532554
ASGN     LTR   3,3                                                      10532555
CHANGE   BC    6,TEST                  IF TYPE COPY, BC6, IF NOT BC8    10532556
         LH    6,ZERO                  THIS ADDRESS IS MODIFIED         10532557
         BC    8,STOR3                 IF ZERO, A = 0                   10532558
         STH   6,INA                   STORE ASDRESS IN INA             10532559
         SH    2,ONE                   SUBT ONE FROM A                  10532560
         LTR   2,2                     TEST FOR A ' ZERO                10532561
         BC    8,STOR                                                   10532562
         AR    6,9                                                      10532563
STOR     STH   6,INB                   STOR ADDRESS IN INB              10532564
         LTR   3,3                     B = 0 TEST                       10532565
         BC    8,STOR2                                                  10532566
         AR    6,9                                                      10532567
         STH   6,OUTA                                                   10532568
         SH    3,ONE                                                    10532569
         LTR   3,3                     B = 0 TEST                       10532570
         BC    8,STOR1                                                  10532571
         AR    6,10                                                     10532572
STOR1    STH   6,OUTB                  STORE ADDRESS IN OUT B           10532573
         BC    15,LOG                                                   10532574
STOR2    MVC   INA(2),OUTA             COMBINED I/O AREAS               10532575
         MVC   INB(2),OUTB             MAKE IN AND OUT CORRESPOND       10532576
         BC    15,LOG                                                   10532577
STOR3    STH   6,INA                   STORE ADDRESS IN                 10532578
         STH   6,OUTA                  INA AND POUT A                   10532579
         BCTR  2,0                                                      10532580
         LTR   2,2                                                      10532581
         BC    8,STOR4                 B = 0 TEST                       10532582
         AR    6,10                                                     10532583
STOR4    STH   6,INB                                                    10532584
         STH   6,OUTB                                                   10532585
LOG      SR    7,7                     CLEAR REG 7 TO ZERO              10532586
         CLC   INA(2),INB                                               10532587
         BC     8,*+8                  /NA EQUAL INB  ADD ONLY 16       10532588
         AH    7,SIXTEN                                                 10532589
         AH    7,SIXTEN                                                 10532590
         CLC    OUTA(2),OUTB                                            10532591
         BC    8,*+8                   OUTA EQUAL OUTB  ADD ONLY 1      10532592
         AH     7,ONE                                                   10532593
         AH     7,ONE                                                   10532594
         STC    7,NOIO                                                  10532595
         BC    15,GOERT                                                 10532596
*                                                                       10532597
***      LOG JOB ROUTINE                                                10532598
*                                                                       10532599
ENDLOG   LH    6,IRCLN                                                  10532600
         MVI   CVD+1,X'60'             CHANGE THE REGISTER IN THE CVD   10532601
         TM    FRCD,X'06'              VARIABLE OR UNDEFINED PROCESSING 10532602
         BC    4,*+20                  BYPASS RECORD FORMAT PRINT       10532603
         BAL   14,CVD                                                   10532604
         UNPK  ER18+20(4),OUTARA(8)                                     10532605
         LA    7,ER18                                                   10532606
         BALR  14,8                    GO TO ERROR ROUTINE              10532607
         LH    6,IBKSZ                                                  10532608
         N     6,ANDOP                 GET RID OF MINUS PROPOGATION     10532609
         BAL   14,CVD                                                   10532610
         UNPK  ER19+17(5),OUTARA(8)          IBKSZ                      10532611
         LA    7,ER19                                                   10532612
         BALR  14,8                    GO TO ERROR ROUTINE              10532613
         TM    FRCD,X'06'              VARIABLE OR UNDEFINED PROCESSING 10532614
         BC    4,*+24                  BYPASS RECORD FORMAT PRINT       10532615
         LH    6,ORCLN                                                  10532616
         BAL   14,CVD                                                   10532617
         UNPK  ER20+22(4),OUTARA(8)                                     10532618
         LA    7,ER20                                                   10532619
         BALR  14,8                    GO TO ERROR ROUTINE              10532620
         LH    6,OBKSZ                                                  10532621
         N     6,ANDOP                 GET RID OF MINUS PROPOGATION     10532622
         BAL   14,CVD                                                   10532623
         UNPK  ER21+18(5),OUTARA(8)      OBKSZ                          10532624
         LA    7,ER21                                                   10532625
         BALR  14,8                    GO TO ERROR ROUTINE              10532626
         TM    SWIT,X'02'              TEST FOR INVALID INPUT OPTION    10532627
         BC    1,TM                                                     10532628
         TM    DOPTN,X'20'             NO REWIND,UNLOAD                 10532629
         BC    8,*+14                                                   10532630
         MVC   ER22+13(16),ER46        MOVE MESSAGE TO MASTER           10532631
         BC    15,PRINTZ               GO WRITE                         10532632
         TM DOPTN,X'10'                TAPE MULTIPLE                    10532633
         BC    8,*+14                                                   10532634
         MVC   ER22+13(13),ER45A       MOVW MESSSAGE TO MASTER          10532635
         BC    15,PRINTZ               GO WRITE                         10532636
         TM    DOPTN,X'40'             TAPE REWIND                      10532637
         BC    8,*+14                                                   10532638
         MVC   ER22+13(11),ER49        MOVE MESSAGE TO MASTER           10532639
         BC    15,PRINTZ               GO WRITE                         10532640
         MVC   ER22+13(18),ER50        TAPE REWIND UNLOAD               10532641
PRINTZ   LA    7,ER22                                                   10532642
         BALR  14,8                                                     10532643
TM       TM    SWIT,X'08'              TEST FOR INVALED OPTION          10532644
         BC    1,RETUNR+6                                               10532645
         TM    DOPTN,X'01'             CARD BINARY                      10532646
         BC    8,*+14                                                   10532647
         MVC   ER23+14(11),ER47        MOVE MESSAGE TO MASTER           10532648
         BC    15,RETUNR                                                10532649
         MVC   ER23+14(8),ER48         CARD BCD                         10532650
RETUNR   LA    7,ER23                                                   10532651
         BALR  14,8                    GO TO ERROR ROUTINE              10532652
         TM    SWIT,X'04'              TEST SUPRESS I/O PRINT SWITCH    10532653
         BC    1,LOADZ+6                                                10532654
         TM    TJOB,X'01'              COPY TEST                        10532655
         BC    1,MUV                                                    10532656
         TM    NOIO,X'02'               2 OUTPUT                        10532657
         BC    1,STORTO                                                 10532658
         MVI   ER24+8,X'F1'            PUT 1 IN OUTPUT                  10532659
ZERT     TM    NOIO,X'20'               2 INPUT                         10532660
         BC    1,STORTT                                                 10532661
         MVI   ER24,X'F1'              PUT 1 IN INPUT                   10532662
LOADZ    LA    7,ER24                                                   10532663
         BALR  14,8                    GO TO ERROR ROUTINE              10532664
         TM    FRCD,X'01'              FIXED INPUT                      10532665
         BC    1,FIXED                                                  10532666
         TM    FRCD,X'02'              VARIABLE INPUT                   10532667
         BC    1,VAR                                                    10532668
         MVC   ER32+14(9),ER40         MOVE UNDEFINED TO MESSAGE        10532669
LO       LA    7,ER32                                                   10532670
         BALR  14,8                                                     10532671
         TM    SWIT,X'20'              INVALID PROGRAM TYPE             10532672
         BC    1,WRITE+6                                                10532673
         TM    TJOB,X'01'              TYPE COPY                        10532674
         BC    8,*+14                                                   10532675
         MVC   ER33+5(4),ER39A                                          10532676
         BC    15,WRITE                                                 10532677
         TM    TJOB,X'02'              FIELD SELECT                     10532678
         BC    8,*+14                                                   10532679
         MVC   ER33+5(12),ER39B                                         10532680
         BC    15,WRITE                                                 10532681
         TM    TJOB,X'04'              REBLOCK                          10532682
         BC    8,*+14                                                   10532683
         MVC   ER33+5(7),ER39C                                          10532684
         BC    15,WRITE                                                 10532685
         MVC   ER33+5(21),ER39D        REBLOCK AND FIELD SELECT         10532686
WRITE    LA    7,ER33                                                   10532687
         BALR  14,8                                                     10532688
         LH    6,QORS                                                   10532689
         BAL   14,CVD                  PUT COLUMN IN REG (SEQ)          10532690
         UNPK  ER35+26(2),OUTARA(8)                                     10532691
         LA    7,ER35                                                   10532692
         BALR  14,8                                                     10532693
         LH    6,QORS+2                                                 10532694
         BAL   14,CVD                  PUT LENGTH IN REG (SEQ)          10532695
         UNPK  ER36+16(2),OUTARA(8)                                     10532696
         LA    7,ER36                                                   10532697
         BALR  14,8                                                     10532698
         LH    11,FOR096                                                10532699
         CH    11,ZERO                                                  10532700
         BC    8,SVC                                                    10532701
         SVC   1                                                        10532702
         DC    C'SYSEOJ'                                                10532703
SVC      SVC   1                                                        10532704
         DC    C'SYSLOD'                                                10532705
MUV      TM    NOIO,X'02'                                               10532706
         BC    1,STTT                                                   10532707
         MVI   ER25,X'F1'              PUT 1 IN I/O                     10532708
ZIPPY    LA    7,ER25                                                   10532709
         BALR  14,8                    GO TO ERROR ROUTINE              10532710
         BC    15,LOADZ+6                                               10532711
STTT     MVI   ER25,X'F2'              PUT 2 IN I/O                     10532712
         BC    15,ZIPPY                                                 10532713
STORTO   MVI   ER24+8,X'F2'            PUT 2 IN OUTPUT                  10532714
         BC    15,ZERT                                                  10532715
STORTT   MVI   ER24,X'F2'              PUT 2 IN INPUT                   10532716
         BC    15,LOADZ                                                 10532717
CVD      CVD   10,OUTARA               CONVERT TO DECIMAL               10532718
         OI    OUTARA+7,X'0F'          PUT SIGN INTO CONVERTED NUMBER   10532719
         BCR   15,14                                                    10532720
FIXED    MVC   ER32+14(9),ER42         MOVE FIXED TO MESSAGE            10532721
         BC    15,LO                                                    10532722
VAR      MVC   ER32+14(9),ER41         MOVE VARIABLE TO MESAGE          10532723
         BC    15,LO                                                    10532724
*                                                                       10532725
***      CONSTANTS                                                      10532726
*                                                                       10532727
         CNOP  0,8                                                      10532728
OUTARA   DC    D'0'                                                     10532729
CCB      DC    F'0'                                                     10532730
         DC    X'0014'                                                  10532731
         DC    YL2(COM)                                                 10532732
COM      DC    X'09'                                                    10532733
         DC    AL3(ER00)                                                10532734
         DC    X'20000032'                                              10532735
ANDOP    DC    X'0000FFFF'                                              10532736
MOVE     MVC   0(0,0),0(0)              DUMMY INST                      10532737
BRANCH   BCR   15,7                                                     10532738
UNPK1    UNPK  0(15,0),0(8,0)                                           10532739
MVI      MVI   0(0),X'F0'                                               10532740
MVC      MVC   0(0,0),0(0)                                              10532741
UNPK2    UNPK  0(0,0),0(0,0)                                            10532742
PACK1    PACK  0(8,0),0(15,0)                                           10532743
XCL      XC    0(0,0),0(0)                                              10532744
PACK2    PACK  0(8,0),0(15,0)                                           10532745
ERRO1    LA    7,ER17                                                   10532746
         BAL   14,CVD                                                   10532747
         UNPK  ER17(3),OUTARA(8)                                        10532748
         BALR  14,8                    GO TO ERROR ROUTINE              10532749
         BC    15,L                                                     10532750
ERRO     LA    7,ER15                                                   10532751
         BAL   14,CVD                                                   10532752
         UNPK  ER15(3),OUTARA(8)                                        10532753
         BALR  14,8                    GO TO ERROR ROUTINE              10532754
         BC    15,L                                                     10532755
XTEN     DC    X'A000'                                                  10532756
XSIX     DC    X'6000'                                                  10532757
ZERO     DC    H'0'                                                     10532758
ONE      DC    X'0001'                                                  10532759
TWO      DC    H'2'                                                     10532760
THREE    DC    H'3'                                                     10532761
SIX      DC    H'6'                                                     10532762
SEVEN    DC    H'7'                                                     10532763
EIGHT    DC    H'8'                                                     10532764
TEN      DC    H'10'                                                    10532765
TWELVE   DC    H'12'                                                    10532766
FORTEN   DC    H'14'                                                    10532767
SIXTEN   DC    H'16'                                                    10532768
EIGHTY   DC    H'80'                                                    10532769
ATEY3    DC    H'83'                                                    10532770
ONE60    DC    H'160'                                                   10532771
TWO56    DC    H'256'                                                   10532772
FOR096   DC    H'4096'                                                  10532773
ATEK     DC    H'8192'                                                  10532774
SWIT     DC    X'0000'                                                  10532775
KONST    DC    X'EF00'                                                  10532776
MAXIO    DC    H'0'                                                     10532777
         DC    X'20'                                                    10532778
ER00     DC    C'TAPE TO CARD UTI'                                      10532779
         DC    C'LITY            '                                      10532780
         DC    F'0'                                                     10532781
         DC    X'11'                                                    10532782
ER0      DC    C'INCORRECT PROGRA'                                      10532783
         DC    C'M'                                                     10532784
         DC    X'16'                                                    10532785
ER1      DC    C'INCORRECT INPUT '                                      10532786
         DC    C'DEVICE'                                                10532787
         DC    X'17'                                                    10532788
ER2      DC    C'INCORRECT OUTPUT'                                      10532789
         DC    C' DEVICE'                                               10532790
         DC    X'1E'                                                    10532791
ER3      DC    C'B ILLEGAL FORMAT'                                      10532792
         DC    C' UTIL MOD CARD'                                        10532793
         DC    X'23'                                                    10532794
ER5      DC    C'FIXED LENGTH REC'                                      10532795
         DC    C'ORD FORMAT REQUI'                                      10532796
         DC    C'RED'                                                   10532797
         DC    X'1C'                                                    10532798
ER6      DC    C'INVALID JOB FOR '                                      10532799
         DC    C'THIS PROGRAM'                                          10532800
         DC    X'1B'                                                    10532801
ER7      DC    C'INVALID INPUT RE'                                      10532802
         DC    C'CORD LENGTH'                                           10532803
         DC    X'1A'                                                    10532804
ER8      DC    C'INVALID INPUT BL'                                      10532805
         DC    C'OCK LENGTH'                                            10532806
         DC    X'1C'                                                    10532807
ER9      DC    C'INVALID OUTPUT R'                                      10532808
         DC    C'ECORD LENGTH'                                          10532809
         DC    X'1B'                                                    10532810
ER10     DC    C'INVALID OUTPUT B'                                      10532811
         DC    C'LOCK LENGTH'                                           10532812
         DC    X'14'                                                    10532813
ER11     DC    C'INVALID INPUT OP'                                      10532814
         DC    C'TION'                                                  10532815
         DC    X'15'                                                    10532816
ER12     DC    C'INVALID OUTPUT O'                                      10532817
         DC    C'PTION'                                                 10532818
         DC    X'15'                                                    10532819
ER13     DC    C'INVALID CARD SEQ'                                      10532820
         DC    C'UENCE'                                                 10532821
         DC    X'1B'                                                    10532822
ER14     DC    C'I/O AREA CANNOT '                                      10532823
         DC    C'BE ASSIGNED'                                           10532824
         DC    X'20'                                                    10532825
ER15     DC    C'    INVALID UNPA'                                      10532826
         DC    C'CK OUTPUT LENGTH'                                      10532827
         DC    X'24'                                                    10532828
ER16     DC    C'    RECORD CAPAC'                                      10532829
         DC    C'ITY EXCEEDED BY '                                      10532830
         DC    C'    '                                                  10532831
         DC    X'1E'                                                    10532832
ER17     DC    C'    INVALID PACK'                                      10532833
         DC    C' OUTPUT LENGTH'                                        10532834
         DC    X'18'                                                    10532835
ER18     DC    C'INPUT RECORD LEN'                                      10532836
         DC    C'GTH     '                                              10532837
         DC    X'16'                                                    10532838
ER19     DC    C'INPUT BLOCK SIZE'                                      10532839
         DC    C'      '                                                10532840
         DC    X'1A'                                                    10532841
ER20     DC    C'OUTPUT RECORD LE'                                      10532842
         DC    C'NGTH      '                                            10532843
         DC    X'17'                                                    10532844
ER21     DC    C'OUTPUT BLOCK SIZ'                                      10532845
         DC    C'E      '                                               10532846
         DC    X'20'                                                    10532847
ER22     DC    C'INPUT OPTION    '                                      10532848
         DC    C'                '                                      10532849
         DC    X'20'                                                    10532850
ER23     DC    C'OUTPUT OPTION   '                                      10532851
         DC    C'                '                                      10532852
         DC    X'1F'                                                    10532853
ER24     DC    C'  INPUT,  OUTPUT'                                      10532854
         DC    C' AREAS ASSIGNED'                                       10532855
         DC    X'20'                                                    10532856
ER25     DC    C'   INPUT / OUTPU'                                      10532857
         DC    C'T AREAS ASSIGNED'                                      10532858
         DC    X'1E'                                                    10532859
ER26     DC    C'FIELD SELECT MUS'                                      10532860
         DC    C'T BE SPECIFIED'                                        10532861
         DC    X'21'                                                    10532862
ER31     DC    C'         INPUT L'                                      10532863
         DC    C'ENGTH EQUALS ZER'                                      10532864
         DC    C'O'                                                     10532865
         DC    X'17'                                                    10532866
ER32     DC    C'RECORD FORMAT   '                                      10532867
         DC    C'       '                                               10532868
         DC    X'1D'                                                    10532869
ER33     DC    C'TYPE            '                                      10532870
         DC    C'             '                                         10532871
         DC    X'1C'                                                    10532872
ER35     DC    C'STARTING SEQUENC'                                      10532873
         DC    C'E COLUMN    '                                          10532874
         DC    X'12'                                                    10532875
ER36     DC    C'SEQUENCE LENGTH '                                      10532876
         DC    C'  '                                                    10532877
ER39A    DC    C'COPY'                                                  10532878
ER39B    DC    C'FIELD SELECT'                                          10532879
ER39C    DC    C'REBLOCK'                                               10532880
ER39D    DC    C'REBLOCK, FIELD S'                                      10532881
         DC    C'ELECT'                                                 10532882
ER40     DC    C'UNDEFINED'                                             10532883
ER41     DC    C'VARIABLE '                                             10532884
ER42     DC    C'FIXED    '                                             10532885
ER43     DC    C'FS  '                                                  10532886
ER44     DC    C'UNPK'                                                  10532887
ER45     DC    C'PACK'                                                  10532888
ER45A    DC    C'TAPE MULTIPLE   '                                      10532889
ER46     DC    C'NO REWIND,UNLOAD'                                      10532890
ER47     DC    C'CARD BINARY'                                           10532891
ER48     DC    C'CARD BCD'                                              10532892
ER49     DC    C'TAPE REWIND'                                           10532893
ER50     DC    C'TAPE REWIND,UNLO'                                      10532894
         DC    C'AD'                                                    10532895
         DC    X'21'                                                    10532896
ERWR     DC    C'    CAN NOT PROC'                                      10532897
         DC    C'ESS HEX PARAMETE'                                      10532898
         DC    C'R'                                                     10532899
         ORG   STAR+3826                                                10532900
NOFS     DS    H                                                        10532901
         END   START                                                    10532902
         TITLE 'PHASE 3&4 TAPE TO CARD'                                 10532903
         START 2752                                                     10532904
*                                                                       10532905
***   ** PASE IV,  TAPE TO CARD PROGRAM **                              10532906
STRT     BALR  15,0                                                     10532907
         USING *,15                                                     10532908
         BC    15,INI3                                                  10532909
SORS     EQU   2500                                                     10532910
QORS     EQU   2504                                                     10532911
IRCLN    EQU   2508                                                     10532912
IBKSZ    EQU   2510                                                     10532913
ORCLN    EQU   2512                                                     10532914
OBKSZ    EQU   2514                                                     10532915
TPGM     EQU   2516                                                     10532916
TJOB     EQU   2517                                                     10532917
FRCD     EQU   2518                                                     10532918
DOPTN    EQU   2519                                                     10532919
POPTN    EQU   2520                                                     10532920
LABSW    EQU   2521                                                     10532921
ICU      EQU   2522                                                     10532922
OCU      EQU   2523                                                     10532923
IBKC     EQU   2524                                                     10532924
OBKC     EQU   2528                                                     10532925
LABIH    EQU   2532                                                     10532926
LABOH    EQU   2534                                                     10532927
LABIT    EQU   2536                                                     10532928
LABOT    EQU   2538                                                     10532929
LABOR    EQU   2540                                                     10532930
AAST     EQU   2542                                                     10532931
LABRTN   EQU   2544                                                     10532932
IPA      EQU   2546                                                     10532933
OPA      EQU   2548                                                     10532934
INA      EQU   2550                                                     10532935
INB      EQU   2552                                                     10532936
OUTA     EQU   2554                                                     10532937
OUTB     EQU   2556                                                     10532938
UCLIM    EQU   2558                                                     10532939
SWHD     EQU   2560                                                     10532940
NOIO     EQU   2561                                                     10532941
HEAD     EQU   2562                                                     10532942
DSTBL    EQU   2706                                                     10532943
*                                                                       10532944
***   INPUT OPERATION                                                   10532945
*                                                                       10532946
         LA    15,2754                                                  10532947
         LM    1,10,REG                                                 10532948
SET1     LH    7,22           STORE THE ADDRESS OF PUB                  10532949
         TM    18(7),X'08'    IS 1402 OUTPUT                            10532950
         BC    1,OPEN         YES, BRANCH TO SET                        10532951
SET2     SVC   0              EJECT CARD                                10532952
         DC    YL2(CCBEJ)                                               10532953
         TM    CCBEJ+2,X'80'                                            10532954
         BC    8,*-4                                                    10532955
         OI    CCWOB,X'C1'                                              10532956
         OI    CCWOA,X'C1'                                              10532957
OPEN     LA    7,P3IH+2                                                 10532958
         STH   7,LABRTN                                                 10532959
         STM   1,10,REG                                                 10532960
         LH    7,LABIH                                                  10532961
P3IH     BCR   15,7           BRANCH TO OPEN INPUT FILE                 10532962
         LM    1,10,REG                                                 10532963
         BC    15,AAA                                                   10532964
         LA    7,PH3IH+2                                                10532965
         STH   7,LABIH                                                  10532966
AAA      LH    11,OUTA        CLEAR OUTPUT AREA                         10532967
         LH    7,OBKSZ                                                  10532968
         BCTR  7,0                                                      10532969
         BCTR  7,0                                                      10532970
         MVI   0(11),X'40'                                              10532971
         STC   7,*+5                                                    10532972
         MVC   1(0,11),0(11)                                            10532973
         LH    11,OUTB                                                  10532974
         MVI   0(11),X'40'                                              10532975
         STC   7,*+5                                                    10532976
         MVC   1(0,11),0(11)                                            10532977
ISVC     DC    X'4700'                                                  10532978
         DC    YL2(CCBIA)                                               10532979
AA3      BC    0,AG3          IS INPUT AREA EXHAUSTED                   10532980
AB3      BC    0,AB2          IS 1-INPUT AREA                           10532981
         TM    2(1),X'80'     WAIT INPUT                                10532982
         BC    8,*-4                                                    10532983
RTN1     LH    7,IAREA                                                  10532984
         CLC   CHKPT(12),0(7) IS CHECK POINT                            10532985
         BC    8,TST4         YES, BRANCH TO TST4                       10532986
CH4      BC    0,CPT4+4                                                 10532987
         TM    3(1),X'04'     IS INPUT END OF FILE                      10532988
         BC    7,IEOV                                                   10532989
         NI    IEOV+1,X'0F'                                             10532990
         L     7,IBKC         COUNT THE NUMBER OF BLOCKS                10532991
         LA    7,1(7)                                                   10532992
         ST    7,IBKC                                                   10532993
         TM    2(1),X'40'     IS INCORRECT LENGTH                       10532994
         BC    8,AD4          NO                                        10532995
         MVC   RSCNT(2),0(1)  YES                                       10532996
         LA    11,RRLMG+35                                              10532997
         L     7,IBKC                                                   10532998
         CVD   7,DRCNO                                                  10532999
         OI    DRCNO+7,X'0F'                                            10533000
         UNPK  0(7,11),DRCNO(8)                                         10533001
         CLI   0(11),X'F0'                                              10533002
         BC    7,*+16                                                   10533003
         MVI   0(11),X'F0'                                              10533004
         LA    11,1(11)                                                 10533005
         BC    15,*-16                                                  10533006
         SVC   0              LOG MESSAGE                               10533007
         DC    YL2(CCBER)                                               10533008
         TM    CCBER+2,X'80'                                            10533009
         BC    8,*-4                                                    10533010
         OI    WRGBC+1,X'F0'                                            10533011
AD4      BC    15,CHGIM       CHANG INPUT LIST                          10533012
         MVC   ITAREA(2),INB                                            10533013
         MVC   IAREA(2),INA                                             10533014
         LA    1,CCBIA                                                  10533015
         STH   1,CHGI1                                                  10533016
         LH    6,INB                                                    10533017
         LR    5,6                                                      10533018
         AH    5,IBKSZ                                                  10533019
         BCTR  5,0                                                      10533020
         BC    15,CHGIX                                                 10533021
CHGIM    MVC   ITAREA(2),INA                                            10533022
         MVC   IAREA(2),INB                                             10533023
         LA    1,CCBIB                                                  10533024
         STH   1,CHGI1                                                  10533025
         LH    6,INA                                                    10533026
         LR    5,6                                                      10533027
         AH    5,IBKSZ                                                  10533028
         BCTR  5,0                                                      10533029
CHGIX    XI    AD4+1,X'F0'                                              10533030
WRGBC    BC    0,WRG                                                    10533031
         SVC   0              EXECUTE INPUT                             10533032
CHGI1    DC    YL2(CCBIB)                                               10533033
         BC    15,AG3                                                   10533034
CPT4     STH   1,*+6          SKIP READING                              10533035
         SVC   0                                                        10533036
         DS    H                                                        10533037
         BC    15,AB3+4                                                 10533038
TST4     TM    CH4+1,X'F0'    IS FIRT CHKPT RECORD                      10533039
         BC    8,CPFT4        YES, BRANCH TO CPFT4                      10533040
         NI    CH4+1,X'0F'    SET BRANCH INSTRUCTION                    10533041
         BC    15,CPT4+4                                                10533042
CPFT4    OI    CH4+1,X'F0'    SET BRANCH INSTRUCTION                    10533043
         BC    15,CPT4                                                  10533044
WRG      SH    5,RSCNT                                                  10533045
         NI    WRGBC+1,X'0F'                                            10533046
         BC    15,WRGBC+4                                               10533047
TST2     TM    CH2+1,X'F0'    IS FIRST TIME                             10533048
         BC    8,CPFT2        YES, BRANCH TO CPFT2                      10533049
         NI    CH2+1,X'0F'    SET BRANCH INSTRUCTION                    10533050
         BC    15,AD1-4                                                 10533051
CPFT2    OI    CH2+1,X'F0'    SET BRANCH INSTRUCYION                    10533052
         BC    15,AD1-4                                                 10533053
MCC2     LH    7,CCWOA+6      MODIFY COUNT                              10533054
         SH    7,RSCNT                                                  10533055
         STH   7,CCWOA+6                                                10533056
         STH   7,CCWOB+6                                                10533057
         BC    15,AF1                                                   10533058
AC2      NI    AB2+1,X'0F'                                              10533059
         BC    15,AD1                                                   10533060
AB2      BC    0,AC2                                                    10533061
         STH   1,*+6                                                    10533062
         SVC   0              EXECUTE INPUT                             10533063
         DC    YL2(CCBIA)                                               10533064
AD1      TM    2(1),X'80'     WAIT INPUT                                10533065
         BC    8,*-4                                                    10533066
RTN2     LH    7,IAREA        IS CHECK POINT RECORD                     10533067
         CLC   CHKPT(12),0(7)                                           10533068
         BC    8,TST2         YES, BRANCH TO TST2                       10533069
CH2      BC    0,AD1-4                                                  10533070
         TM    3(1),X'04'     IS INPUT END OF FILE                      10533071
         BC    7,IEOV                                                   10533072
         NI    IEOV+1,X'0F'                                             10533073
         L     7,IBKC         COUNT THE NUMBER OF BLOCKS                10533074
         LA    7,1(7)                                                   10533075
         ST    7,IBKC                                                   10533076
         LH    6,INA                                                    10533077
         LR    5,6                                                      10533078
         AH    5,IBKSZ                                                  10533079
         BCTR  5,0                                                      10533080
         TM    2(1),X'40'     IS INCORRECT LENGTH                       10533081
         BC    8,AF1          NO                                        10533082
         MVC   RSCNT(2),0(1)  YES                                       10533083
         TM    FRCD,X'01'     IS FIXED RECORD                           10533084
         BC    8,MCC2         NO, BRANCH TO MCC                         10533085
         LA    11,RRLMG+35                                              10533086
         L     7,IBKC                                                   10533087
         CVD   7,DRCNO                                                  10533088
         OI    DRCNO+7,X'0F'                                            10533089
         UNPK  0(7,11),DRCNO(8)                                         10533090
         CLI   0(11),X'F0'                                              10533091
         BC    7,*+16                                                   10533092
         MVI   0(11),X'F0'                                              10533093
         LA    11,1(11)                                                 10533094
         BC    15,*-16                                                  10533095
         SVC   0              LOG MESSAGE                               10533096
         DC    YL2(CCBER)                                               10533097
         TM    CCBER+2,X'80'                                            10533098
         BC    8,*-4                                                    10533099
         TM    TJOB,X'01'     IS COPY                                   10533100
         BC    1,MCC2                                                   10533101
         SH    5,RSCNT                                                  10533102
AF1      BC    15,CHGM        CHANGE INPUT LIST                         10533103
         MVC   ITAREA(2),INB                                            10533104
         MVC   IAREA(2),INA                                             10533105
         LA    1,CCBIA                                                  10533106
         STH   1,CHGI2                                                  10533107
         BC    15,CHGX                                                  10533108
CHGM     MVC   ITAREA(2),INA                                            10533109
         MVC   IAREA(2),INB                                             10533110
         LA    1,CCBIB                                                  10533111
         STH   1,CHGI2                                                  10533112
CHGX     LH    6,INA                                                    10533113
         XI    AF1+1,X'F0'                                              10533114
*                                                                       10533115
***   MAIN LINE                                                         10533116
*                                                                       10533117
*                                                                       10533118
***   SHIFT ROUTINE                                                     10533119
*                                                                       10533120
AG3      TM    TJOB,X'01'     IS COPY                                   10533121
         BC    1,AK3          YES, BRANCH TO AK3                        10533122
         LA    7,RTN3         NO, BRANCH TO PHASE II                    10533123
         LH    11,UCLIM                                                 10533124
         BCR   15,11                                                    10533125
RTN3     BXLE  6,4,SSICHK     MODIFY INPUT LOGICAL RECORD ADDRESS       10533126
         NI    AA3+1,X'0F'                                              10533127
         NI    BB3+1,X'0F'                                              10533128
         BC    15,SSOCHK                                                10533129
SSICHK   OI    AA3+1,X'F0'                                              10533130
         OI    BB3+1,X'F0'                                              10533131
SSOCHK   BXLE  10,8,*+12      MODIFY OUTPUT LOGICAL RECORD ADDRESS      10533132
         NI    BA3+1,X'0F'                                              10533133
         BC    15,AK3                                                   10533134
         OI    BA3+1,X'F0'                                              10533135
*                                                                       10533136
***   CARD SEQUENCE GENERATION                                          10533137
*                                                                       10533138
AK3      BC    15,BA3         IS SEQ GENERATION SPECIFIED               10533139
         LH    7,QNO                                                    10533140
         LA    7,1(7)                                                   10533141
         STH   7,QNO                                                    10533142
         CVD   7,DRCNO                                                  10533143
         OI    DRCNO+7,X'0F'                                            10533144
         LH    7,OTAREA                                                 10533145
QGUNPK   UNPK  0(1,7),DRCNO(8)                                          10533146
*                                                                       10533147
***   AUXILIARY INPUT OPERATION                                         10533148
*                                                                       10533149
BA3      BC    0,AA3          IS OUTPUT AREA EXHAUSTED                  10533150
BB3      BC    0,BD3          IS INPUT AREA EXHAUSTED                   10533151
BB2      BC    0,BD3          IS 1-INPUT AREA                           10533152
         SVC   0              EXECUTE INPUT                             10533153
CHGI2    DC    YL2(CCBIB)                                               10533154
         OI    AB2+1,X'F0'                                              10533155
*                                                                       10533156
***   OUTPUT OPERATION                                                  10533157
*                                                                       10533158
BD3      BC    0,BD2          IS 1-OUTPUT AREA                          10533159
         BC    15,BH4                                                   10533160
         TM    2(2),X'80'     WAIT OUTPUT                               10533161
         BC    8,*-4                                                    10533162
BF4      BC    15,CHGOM       CHANG OUTPUT LIST                         10533163
         MVC   OTAREA(2),OUTA                                           10533164
         LA    2,CCBOB                                                  10533165
         STH   2,CHGO1                                                  10533166
         LH    10,OUTA                                                  10533167
         BC    15,CHGOX                                                 10533168
CHGOM    MVC   OTAREA(2),OUTB                                           10533169
         LA    2,CCBOA                                                  10533170
         STH   2,CHGO1                                                  10533171
         LH    10,OUTB                                                  10533172
CHGOX    XI    BF4+1,X'F0'                                              10533173
         LR    9,10                                                     10533174
         AH    9,OBKSZ                                                  10533175
         BCTR  9,0                                                      10533176
         SVC   0              EXECUTE OUTPUT                            10533177
CHGO1    DC    YL2(CCBOA)                                               10533178
         BC    15,AA3                                                   10533179
BH4      NI    BD3+5,X'0F'                                              10533180
         BC    15,BF4                                                   10533181
BD2      SVC   0              EXECUTE OUTPUT                            10533182
CHGO2    DC    YL2(CCBOA)                                               10533183
         TM    2(2),X'80'     WAIT OUTPUT                               10533184
         BC    8,*-4                                                    10533185
         LH    7,OBKSZ                                                  10533186
         STH   7,CCWOA+6                                                10533187
         STH   7,CCWOB+6                                                10533188
BG2      BC    15,CHGMO       CHANGE OUTPUT LIST                        10533189
         MVC   OTAREA(2),OUTA                                           10533190
         LA    2,CCBOA                                                  10533191
         STH   2,CHGO2                                                  10533192
         BC    15,CHGXO                                                 10533193
CHGMO    MVC   OTAREA(2),OUTB                                           10533194
         LA    2,CCBOB                                                  10533195
         STH   2,CHGO2                                                  10533196
CHGXO    XI    BG2+1,X'F0'                                              10533197
         LH    10,OUTA                                                  10533198
         BC    15,AA3                                                   10533199
*                                                                       10533200
***   TAPE INPUT END OF FILE ROUTINE                                    10533201
*                                                                       10533202
IEOV     BC    15,ISVC                                                  10533203
         LA    7,P3IT+2                                                 10533204
         STH   7,LABRTN                                                 10533205
         STM   1,10,REG                                                 10533206
         LH    7,LABIT                                                  10533207
P3IT     BCR   15,7           BRANCH TO INPUT TRAILOR LABEL             10533208
         LM    1,10,REG                                                 10533209
         TM    DOPTN,X'90'    IS UNLOAD OPTIOM                          10533210
         BC    8,IERW         NO, BRANCH TO IERW                        10533211
         MVI   CCWIA,X'0F'    UNLOAD TAPE                               10533212
         SVC   0                                                        10533213
         DC    YL2(CCBIA)                                               10533214
         TM    CCBIA+2,X'80'                                            10533215
         BC    8,*-4                                                    10533216
         MVI   CCWIA,X'02'                                              10533217
IERW     TM    DOPTN,X'40'    IS REWIND OPTION                          10533218
         BC    8,IEPS         NO, BRANCH TO IEPS                        10533219
         MVI   CCWIA,X'07'    REWIND TAPE                               10533220
         SVC   0                                                        10533221
         DC    YL2(CCBIA)                                               10533222
         TM    CCBIA+2,X'80'                                            10533223
         BC    8,*-4                                                    10533224
         MVI   CCWIA,X'02'                                              10533225
IEPS     TM    LABSW,X'10'    IS EOV OR EOF DEFINED                     10533226
         BC    7,TEOF         YES, BRANCH TO TEOF                       10533227
ANSWR    SVC   2              WAIT FOR OPERATOR S ANSWER                10533228
         DC    CL6'3ANSA '                                              10533229
         CLI   ANSWR+7,C'Y'   IS EOF                                    10533230
         BC    8,B3           YES, BRANCH TO B3                         10533231
         CLI   ANSWR+7,C'N'   IS EOV                                    10533232
         BC    7,ANSWR        NO, WAIT IT AGAIN                         10533233
         NI    LABSW,X'7F'    YES, SET LABSW                            10533234
TEOF     TM    LABSW,X'80'    IS EOF                                    10533235
         BC    1,B3           YES, BRANCH TO B3                         10533236
         SR    7,7            LOG END OF REEL FOR INPUT                 10533237
         IC    7,ICU                                                    10533238
         AH    7,22                                                     10533239
         MVO   FMVO(2),0(2,7)                                           10533240
         UNPK  EORMG+18(3),FMVO(2)                                      10533241
         SVC   0                                                        10533242
         DC    YL2(CCBEOR)                                              10533243
         TM    CCBEOR+2,X'80'                                           10533244
         BC    8,*-4                                                    10533245
FLBC     BC    15,*+12        SET CURRENT UNIT                          10533246
         IC    7,IPA                                                    10533247
         BC    15,*+8                                                   10533248
         IC    7,IPA+1                                                  10533249
         STC   7,ICU                                                    10533250
         STC   7,CCBIA+5                                                10533251
         STC   7,CCBIB+5                                                10533252
         XI    FLBC+1,X'F0'                                             10533253
         LA    7,PH3IH+2      SET LINKAGE                               10533254
         STH   7,LABRTN                                                 10533255
         STM   1,10,REG                                                 10533256
         LH    7,LABIH                                                  10533257
PH3IH    BCR   15,7           BRANCH TO OPEN INPUT FILE                 10533258
         LM    1,10,REG                                                 10533259
         XC    IBKC(4),IBKC                                             10533260
         MVC   IEOV(4),EXIBC                                            10533261
EXI      STH   1,*+6                                                    10533262
         SVC   0              EXECUTE INPUT                             10533263
         DS    H                                                        10533264
         TM    2(1),X'80'                                               10533265
         BC    8,*-4                                                    10533266
         TM    AB3+1,X'F0'    IS 1-INPUT AREA                           10533267
         BC    1,RTN2         YES, BRANCH TO RTN2                       10533268
         BC    15,RTN1        NO, BRANCH TO TRN1                        10533269
EXIBC    BC    15,EXI                                                   10533270
B3       TM    BA3+1,X'F0'    IS OUTPUT AREA EXHAUSTED                  10533271
         BC    8,IEMG         YES, BRANCH TO IEMG                       10533272
         SH    10,OTAREA      NO, COUNT BLOCKING SIZE                   10533273
         STH   10,CCWOA+6     STORE COUNT AT COMMAND WORDS              10533274
         STH   10,CCWOB+6                                               10533275
         LA    3,IEWT         GENERATE LINKAGE TO OUTPUT OPERATION      10533276
         LH    7,BCR                                                    10533277
         STH   7,CHGO1+2                                                10533278
         STH   7,CHGO2+2                                                10533279
         BC    15,BD3                                                   10533280
BCR      BCR   15,3                                                     10533281
IEWT     TM    2(2),X'80'     WAIT OUTPUT                               10533282
         BC    8,*-4                                                    10533283
IEMG     SVC   0              LOG MESSAGE                               10533284
         DC    YL2(CCBLG1)                                              10533285
         TM    CCBLG1+2,X'80' WAIT TYPING                               10533286
         BC    8,*-4                                                    10533287
         SVC   1              TERMINATE JOB                             10533288
         DC    CL6'SYSEOJ'                                              10533289
*                                                                       10533290
***   CONSTANT                                                          10533291
*                                                                       10533292
         CNOP  0,8                                                      10533293
REG      DS    CL40                                                     10533294
DRCNO    DC    C'        '                                              10533295
CCBIA    DC    X'00000000'                                              10533296
         DC    X'000C'                                                  10533297
         DC    YL2(CCWIA)                                               10533298
CCBIB    DC    X'00000000'                                              10533299
         DC    X'000C'                                                  10533300
         DC    YL2(CCWIB)                                               10533301
CCBOA    DC    X'00000000'                                              10533302
         DC    X'0010'                                                  10533303
         DC    YL2(CCWOA)                                               10533304
CCBOB    DC    X'00000000'                                              10533305
         DC    X'0010'                                                  10533306
         DC    YL2(CCWOB)                                               10533307
CCBLG1   DC    X'00000000'                                              10533308
         DC    X'0014'                                                  10533309
         DC    YL2(CCWLG1)                                              10533310
CCBER    DC    X'00000000'                                              10533311
         DC    X'0014'                                                  10533312
         DC    YL2(CCWER)                                               10533313
CCBEJ    DC    X'00000000'                                              10533314
         DC    X'0010'                                                  10533315
         DC    YL2(CCWEJ)                                               10533316
CCBEOR   DC    X'000000000014'                                          10533317
         DC    YL2(CCWEOR)                                              10533318
CCWIA    DC    X'0200000000000000'                                      10533319
CCWIB    DC    X'0200000000000000'                                      10533320
CCWOA    DC    X'0100000000000000'                                      10533321
CCWOB    DC    X'0100000000000000'                                      10533322
CCWLG1   DC    X'09'                                                    10533323
         DC    AL3(TMMG)                                                10533324
         DC    X'0000000B'                                              10533325
CCWER    DC    X'09'                                                    10533326
         DC    AL3(RRLMG)                                               10533327
         DC    X'0000002A'                                              10533328
CCWEJ    DC    X'8100'                                                  10533329
         DC    YL2(DRCNO)                                               10533330
         DC    X'40000001'                                              10533331
         DC    X'8100'                                                  10533332
         DC    YL2(DRCNO)                                               10533333
         DC    X'00000001'                                              10533334
CCWEOR   DC    X'09'                                                    10533335
         DC    AL3(EORMG)                                               10533336
         DC    X'00000015'                                              10533337
ITAREA   DS    H                                                        10533338
OTAREA   DS    H                                                        10533339
IAREA    DS    H                                                        10533340
RSCNT    DS    H                                                        10533341
QNO      DC    X'0000'                                                  10533342
FMVO     DC    X'000F'                                                  10533343
TMMG     DC    C' END OF JOB'                                           10533344
RRLMG    DC    C' INCORRECT BLOCK'                                      10533345
         DC    C' LENGTH AT BLK. '                                      10533346
         DC    C'NO.       '                                            10533347
EORMG    DC    C' END OF TAPE REE'                                      10533348
         DC    C'L    '                                                 10533349
CHKPT    DC    C'/// CHKPT //'                                          10533350
LAST     DS    H                                                        10533351
         ORG   LAST+150                                                 10533352
LAB3     MVC   CCBI+5(1),LICU                                           10533353
         MVI   CCWI,X'02'                                               10533354
         BAL   14,PER                                                   10533355
         TM    CCBI+3,X'04'                                             10533356
         BC    1,NN                                                     10533357
         CLC   LABEL(4),EOV1                                            10533358
         BC    8,R1                                                     10533359
         CLC   LABEL(4),EOF1                                            10533360
         BC    8,R2                                                     10533361
NN       TM    SWTIME,X'FF'                                             10533362
         BC    1,BN6                                                    10533363
         TM    CCBI+3,X'04'                                             10533364
         BC    1,RAT                                                    10533365
         TM    USW,X'40'                                                10533366
         BC    1,BN7                                                    10533367
         BC    15,LAB3                                                  10533368
BN7      LA    14,LAB3                                                  10533369
         STH   14,URET                                                  10533370
         LH    14,ULAB2                                                 10533371
         BCR   15,14                                                    10533372
BN6      NI    LABSW,X'EF'                                              10533373
         SVC   0                                                        10533374
         DC    YL2(CCBP)                                                10533375
         TM    CCBP+2,X'80'                                             10533376
         BC    8,*-4                                                    10533377
RAT      MVI   SWTIME,X'FF'                                             10533378
         OI    USW,X'40'                                                10533379
         LH    5,LLABRT                                                 10533380
         BCR   15,5                                                     10533381
         CNOP  0,8                                                      10533382
CCBP     DC    F'0'                                                     10533383
         DC    X'0014'                                                  10533384
         DC    YL2(CCWP)                                                10533385
CCWP     DC    X'09'                                                    10533386
         DC    AL3(PM)                                                  10533387
         DC    X'0000'                                                  10533388
         DC    X'000D'                                                  10533389
PM       DC    C'NO EOV OR EOF'                                         10533390
R1       OI    LABSW,X'10'                   PUT 1 IN 4 BIT             10533391
         NI    LABSW,X'7F'                   PUT 0 IN 1 BIT             10533392
CONT     PACK  FILPAC(8),LABEL+54(6)                                    10533393
         CVB   5,FILPAC                                                 10533394
         MVI   SWTIME,X'00'                                             10533395
         C     5,LIBKC                                                  10533396
         BC    7,MES9                                                   10533397
         BC    15,LAB3                                                  10533398
R2       OI    LABSW,X'90'                   PUT 1 S IN BITS 4 AND 1    10533399
         BC    15,CONT                                                  10533400
MES9     SVC   2                                                        10533401
       DC    C'3IBCA '                                                  10533402
         BC    15,LAB3                                                  10533403
BN3      TM    USW,X'80'                                                10533404
         BC    1,BN4                                                    10533405
         BC    15,LREAD2                                                10533406
BN4      LA    14,LREAD2                                                10533407
         STH   14,URET                                                  10533408
         LH    14,ULAB1                                                 10533409
         BCR   15,14                                                    10533410
PER      SVC   0                                                        10533411
         DC    YL2(CCBI)                                                10533412
         TM    CCBI+2,X'80'                                             10533413
         BC    8,*-4                                                    10533414
         BCR   15,14                                                    10533415
EOV1     DC    C'EOV1'                                                  10533416
EOF1     DC    C'EOF1'                                                  10533417
SWTIME   DC    X'FF'                                                    10533418
         CNOP  0,8                                                      10533419
CCBI     DC    F'0'                                                     10533420
         DC    X'0000'                                                  10533421
       DC    YL2(CCWI7)                                                 10533422
CCWI7  CCW   X'3F',LABEL,X'40',01                                       10533423
CCWI     DC    X'00'                                                    10533424
         DC    AL3(LABEL)                                               10533425
         DC    X'0000'                                                  10533426
         DC    X'0050'                                                  10533427
LABEL    DS    20F                                                      10533428
SW3      DC    X'00'                                                    10533429
         CNOP  0,8                                                      10533430
FILPAC   DC    D'0'                                                     10533431
SAVE8    DC    F'0'                                                     10533432
VOL1     DC    C'VOL1'                                                  10533433
UIN      DC    C'UIN'                                                   10533434
*                                                                       10533435
*                                                                       10533436
HDR1     DC    C'HDR1'                                                  10533437
*                                                                       10533438
LAB1     MVC   CCBI+5(1),LICU           GET INPUT CURRENT UNIT          10533439
       LH    14,22                                                      10533440
       AH    14,CCBI+4                                                  10533441
       MVI   CCWI7,X'3F'                                                10533442
       OC    CCWI7(1),3(14)                                             10533443
       XI    CCWI7,X'14'                                                10533444
LSAVE    L     8,SAVE8                  LOAD VOL SEQ NO IN REG 8        10533445
         LH    1,LAAST                                                  10533446
LREW1    MVI   CCWI,X'07'                                               10533447
         BAL   14,PER                   REWIND TAPE                     10533448
         MVI   CCWI,X'02'                                               10533449
         BAL   14,PER                   READ TAPE  VOL1                 10533450
         CLC   LABEL(4),VOL1            MATCH VOL1                      10533451
         BC    7,LREW2                                                  10533452
         TM    SW3,X'FF'                1ST REEL                        10533453
         BC    1,LREAD1                 BRANCH IF ON SECOND REEL        10533454
         CLC   1(3,1),UIN               MATCH VOL SERIAL NO T/C  GET CA 10533455
         BC    7,ABART                                                  10533456
         CLC   25(6,1),LABEL+4                                          10533457
         BC    7,LMES1                  BRANCH UNEQUAL                  10533458
LREAD1   MVI   CCWI,X'02'                                               10533459
         BAL   14,PER                   READ TAPE VOL                   10533460
         CLC   LABEL(3),VOL1            MATCH VOL                       10533461
         BC    8,LREAD1                 BRANC EQUAL TO READ             10533462
         CLC   LABEL(4),HDR1            MATCH HDR1                      10533463
         BC    7,LLREW2                                                 10533464
         TM    SW3,X'FF'                1ST REEL                        10533465
         BC    1,LMOVE                  BRANCH IF NO 1ST REEL           10533466
         CLC   LABEL+4(49),8(1)         FILE LABEL CHECK                10533467
         BC    7,LMES2                  BRANCH UNEQUAL                  10533468
LSTARE   PACK  FILPAC(8),LABEL+27(4)                                    10533469
         CVB   8,FILPAC                 VOL SEQ NO TO REG 8             10533470
LREAD2   MVI   CCWI,X'02'                                               10533471
         BAL   14,PER                   READ TAPE  UNTIL TAPE MARK      10533472
         TM    CCBI+3,X'04'                                             10533473
         BC    1,LEND                                                   10533474
         CLC   LABEL(3),HDR1                                            10533475
         BC    8,LREAD2                                                 10533476
         BC    15,BN3                                                   10533477
LLREW2   SVC   2                                                        10533478
       DC    C'3IHDA '                                                  10533479
         BC    15,LREW1                                                 10533480
LEND     MVI   SW3,X'FF'                SET ON SW3 1ST REEL             10533481
         ST    8,SAVE8                  STORE VOL SEQ NO COUNTER        10533482
         OI    USW,X'80'                                                10533483
         LH    5,LLABRT                 GET THE ADDRESS RETURN          10533484
         BCR   15,5                     BRANCH TO PH 4                  10533485
LREW2    MVI   CCWI,X'0F'                                               10533486
         BAL   14,PER                   REWIND UNLOAD                   10533487
         SVC   2                                                        10533488
       DC    C'3ISLA '                                                  10533489
         BC    15,LREW1                                                 10533490
LMES1    SVC   2                                                        10533491
       DC    C'3IVSA '                                                  10533492
         CLI   LMES1+7,C'R'                                             10533493
         BC    8,LREW1                                                  10533494
         BC    7,LREAD1                                                 10533495
LMOVE    MVC   31(4,1),LABEL+27                                         10533496
         CLC   LABEL+4(49),8(1)         FILE  LABEL C HECK ROUTINE      10533497
         BC    7,LMES3                                                  10533498
LSTORE   PACK  FILPAC(8),LABEL+27(4)                                    10533499
         CVB   7,FILPAC                                                 10533500
         LA    8,1(8)                   ADD ONE  REG8                   10533501
         CLR   7,8                                                      10533502
         BC    8,LREAD2                                                 10533503
         BC    7,LMES4                                                  10533504
LMES2    SVC   2                                                        10533505
       DC    C'3ICHA '                                                  10533506
         CLI   LMES2+7,C'R'                                             10533507
         BC    8,LREW1                                                  10533508
         BC    7,LSTARE                                                 10533509
LMES3    SVC   2                                                        10533510
       DC    C'3ICHA '                                                  10533511
         CLI   LMES3+7,C'R'                                             10533512
         BC    8,LREW1                                                  10533513
         BC    7,LSTORE                                                 10533514
LMES4    SVC   2                                                        10533515
       DC    C'3ISQA '                                                  10533516
         CLI   LMES4+7,C'R'                                             10533517
         BC    8,LSAVE                                                  10533518
         BC    7,LREAD2                                                 10533519
ABART  SVC   2                                                          10533520
       DC    C'3LCM  '                                                  10533521
       SVC   1                                                          10533522
         DC    C'SYSEOJ'                                                10533523
INI3     LA    1,LREAD2                                                 10533524
         STH   1,ULAB1                                                  10533525
         LA    1,LAB3             INPUT                                 10533526
         STH   1,ULAB2                                                  10533527
         LA    1,LABEL                                                  10533528
         STH   1,ULAB                                                   10533529
         TM    LABSW,X'20'                                              10533530
         BC    8,LOAD                                                   10533531
         LA    1,LAB1                                                   10533532
         STH   1,LLABIH                                                 10533533
         LA    1,LAB3                                                   10533534
         STH   1,LLABIT                                                 10533535
LOAD     BC    15,STAT                                                  10533536
*                                                                       10533537
LLABRT   EQU   2544                                                     10533538
LAAST    EQU   2542                                                     10533539
LIBKC    EQU   2524                                                     10533540
LICU     EQU   2522                                                     10533541
LLABIT   EQU   2536                                                     10533542
LLABIH   EQU   2532                                                     10533543
ULAB     EQU   2732                                                     10533544
URET     EQU   2730                                                     10533545
ULAB4    EQU   2728                                                     10533546
ULAB3    EQU   2726                                                     10533547
ULAB2    EQU   2724                                                     10533548
ULAB1    EQU   2722                                                     10533549
USW      EQU   2734                                                     10533550
*                                                                       10533551
***   INITIALIZATION                                                    10533552
*                                                                       10533553
STAT     TM    DOPTN,X'01'    IS BINARY OUTPUT                          10533554
         BC    8,*+12         NO, BRANCH                                10533555
         MVI   CCWOA,X'21'    YES, MODIFY COMMAND CODES                 10533556
         MVI   CCWOB,X'21'                                              10533557
         LH    1,IBKSZ        STORE COUNT AT COMMAND WORDS              10533558
         STH   1,CCWIA+6                                                10533559
         STH   1,CCWIB+6                                                10533560
         LH    1,OBKSZ                                                  10533561
         STH   1,CCWOA+6                                                10533562
         STH   1,CCWOB+6                                                10533563
         MVC   CCWIA+2(2),INA STORE STARTING ADDRESS AT COMMAND WORDS   10533564
         MVC   CCWIB+2(2),INB                                           10533565
         MVC   CCWOA+2(2),OUTA                                          10533566
         MVC   CCWOB+2(2),OUTB                                          10533567
         LA    1,CCBIA        SET INPUT CCB FOR AREA A                  10533568
         LA    2,CCBOA        SET OUTPUT CCB FOR AREA A                 10533569
         LH    4,IRCLN        SET REGISTER 4,5,6                        10533570
         LH    5,INA                                                    10533571
         STH   5,IAREA                                                  10533572
         LR    6,5                                                      10533573
         AH    5,IBKSZ                                                  10533574
         BCTR  5,0                                                      10533575
         LH    8,ORCLN        SET REGISTER 8,9,10                       10533576
         LH    9,OUTA                                                   10533577
         STH   9,OTAREA                                                 10533578
         LR    10,9                                                     10533579
         AH    9,OBKSZ                                                  10533580
         BCTR  9,0                                                      10533581
         SR    7,7            IS SEQ GENERATION SPECIFIED               10533582
         AH    7,QORS+2                                                 10533583
         BC    8,INLAB        NO, BRANCH TO INLAB                       10533584
         BCTR  7,0            GENERATE UNPK                             10533585
         SLA   7,4                                                      10533586
         AH    7,QGUNPK                                                 10533587
         STC   7,QGUNPK+1                                               10533588
         LH    7,QORS                                                   10533589
         BCTR  7,0                                                      10533590
         STC   7,QGUNPK+3                                               10533591
         NI    AK3+1,X'0F'                                              10533592
INLAB    CLI   LABIH,C'*'     IS OUTPUT LABEL DEFINED                   10533593
         BC    7,*+24         YES, SKIP                                 10533594
         LA    7,P3IH+2       NO, PROVIDE ADDRESSES                     10533595
         STH   7,LABIH                                                  10533596
         LA    7,P3IT+2                                                 10533597
         STH   7,LABIT                                                  10533598
         NI    P3IH+7,X'0F'                                             10533599
         MVC   ICU(1),IPA     SET CURRENT UNIT                          10533600
*                                                                       10533601
***   SETTING SWITCH ROUTINE                                            10533602
*                                                                       10533603
SSR      TM    TJOB,X'01'     IS LIST                                   10533604
         BC    8,IOSC11       NO, BRANCH TO IOSC11                      10533605
         OI    AB3+1,X'F0'                                              10533606
         NI    BA3+1,X'0F'                                              10533607
         OI    BD3+1,X'F0'                                              10533608
         TM    NOIO,X'01'     IS 1-INPUT-OUTPUT AREA                    10533609
         BC    8,STSR         NO, BRANCH TO STSR                        10533610
         OI    BB3+1,X'F0'                                              10533611
         BC    15,DAME                                                  10533612
STSR     NI    BB3+1,X'0F'    NO, 2-INPUT-OUTPUT AREAS                  10533613
         NI    BB2+1,X'0F'                                              10533614
         BC    15,DAME                                                  10533615
IOSC11   TM    NOIO,X'11'     ARE 1-INPUT 1-OUTPUT AREAS                10533616
         BC    12,IOSC12      NO, BRANCH TO IOSC12                      10533617
         OI    AB3+1,X'F0'                                              10533618
         OI    BD3+1,X'F0'                                              10533619
         NI    BB2+1,X'0F'                                              10533620
         BC    15,DAME                                                  10533621
IOSC12   TM    NOIO,X'12'     ARE 1-INPUT 2-OUTPUT AREAS                10533622
         BC    12,IOSC21      NO, BRANCH TO IOSC21                      10533623
         OI    AB3+1,X'F0'                                              10533624
         NI    BB2+1,X'0F'                                              10533625
         NI    BD3+1,X'0F'                                              10533626
         BC    15,DAME                                                  10533627
IOSC21   MVI   ISVC,X'0A'                                               10533628
         NI    AB3+1,X'0F'                                              10533629
         OI    BB2+1,X'F0'                                              10533630
         TM    NOIO,X'21'     ARE 2-INPUT 1-OUTPUT AREAS                10533631
         BC    12,IOSC22      NO, BRANCH TO IOSC22                      10533632
         OI    BD3+1,X'F0'                                              10533633
         BC    15,DAME                                                  10533634
IOSC22   NI    BD3+1,X'0F'                                              10533635
DAME     STM   1,10,REG                                                 10533636
         SVC   1                                                        10533637
         END   STRT                                                     10533638
