         TITLE 'SUPERVISOR'                                             10540001
SYSS00   START 0                                                        10540002
         USING *,0,4                                                    10540003
         ORG   SYSS00+5                                                 10540004
         DC    C' '                                                     10540005
         ORG   SYSS00+88                                                10540006
         DC    X'00040000'              NEW  EXT SIGNAL PSW             10540007
         DC    A(SYSEXT)                                                10540008
         DC    X'00040000'              NEW  SVC INTRT  PSW             10540009
         DC    A(SYSSVC)                                                10540010
         DC    X'00040000'              NEW  PROG CHECK PSW             10540011
         DC    A(SYSSPC)                                                10540012
         DC    X'00060000'              NEW  MACH CHECK PSW             10540013
SYSSMD         DC   X'F0FFFFFF'                                         10540014
         DC    X'00040000'              NEW  IO INTERPT PSW             10540015
         DC    A(SYSXIN)                                                10540016
         DC    YL2(SYSSCR)                                              10540017
         DC    YL2(SYSUTB)                                              10540018
       ORG   SYSS00+144                 DIAGNOSTICS USE 8 BYTES  START  10540019
SYSSLB     DC    X'FF0500000F'                                          10540020
         DC    AL3(SYSLDR)             USE ABSOLUTE LOADER              10540021
SYSS83   DS    D                       TO SAVE PSW BEFORE TIMER RTN     10540022
SYSS86   DS    D                                                        10540023
SYSS81   LM    10,11,SYSS86                                             10540024
         LPSW  SYSS83                  RETURN FROM TIMER RTN            10540025
SYSS84   DS    D                       TO SAVE PSW BEFORE OP.COM RTN    10540026
SYSS87   DS    D                                                        10540027
SYSS03   DC    X'09000000'              CCW WRITE MSG                   10540028
         DC    F'5'                                                     10540029
SYSS04   DC    X'0A000005'              CCW READ  REPLY                 10540030
         DC    F'1'                                                     10540031
SYSZVE   DS    F                       TO SAVE REG 10 FOR MSG HANDLING  10540032
SYSSAC   DS    F                       TO SAVE  REPLY ADDRESS           10540033
SYSSCB   DC    X'1000'                 DUMMY CCB FOR SVC 2 FORCE RTRN   10540034
SYSS93   MVC   24(8),32                                                 10540035
         B     SYSS13                                                   10540036
SYSTWA   DC    X'001F'                 TW ADDRESS                       10540037
SYSSVC   L     12,36                    LOAD ADD IN R12                 10540038
       CLI   35,X'01'       IS V SVC 1                                  10540039
         BL    SYSXCP                   GO TO IOCS (CODE 0)             10540040
         BE    SYSS11                   GO TO FETCH ROUTINE (CODE 1)    10540041
       CLI   35,X'03'       IS V SVC 3                                  10540042
         BNL   SYSS80                                                   10540043
SYSS06   MVC   0(5),0(12)               CODE 2    MESSAGE               10540044
         LA    12,6(12)                 CALCULATE NEXT INSTRUCTION ADDR 10540045
         IC    13,36                   STORE ADDRESS IN PSW             10540046
         ST    12,36                                                    10540047
         STC   13,36                                                    10540048
         BCTR  12,0                    CALCULATE EDDRESS FOR REPLY      10540049
         MVI   SYSS03+4,X'20'          SUPPRESS CHAINING IN CCW         10540050
         CLI   4,C'A'                   IF A  REPLY                     10540051
         BNE   *+8                      IS WANTED PUT CHAINING BIT      10540052
         MVI   SYSS03+4,X'60'                                           10540053
         ST    12,SYSSAC               SAVE ADDRESS FOR REPLY           10540054
         MVC   58(2),SYSTWA            LOAD CH,UNIT ADDRESS             10540055
       LA    12,SYSMSG-SYSQMX                                           10540056
       ST    10,SYSZVE                                                  10540057
         BAL   10,SYSQXS               USE ROUTINE TO SET UP CCW AND T5 10540058
         DC    YL2(SYSS03)             CCW ADDRESS                      10540059
       L     10,SYSZVE                                                  10540060
         TM    SYSSCB,X'20'                                             10540061
         BC    8,SYSS93                 NOT DISASTER,CONTINUE           10540062
SYSS09   OI    32,X'01'                 UNMASK EXT IN                   10540063
         OI    33,X'02'                 AND ENTER WAIT STATE            10540064
SYSXST LPSW  32                         RETURN TO MAIN LINE   SVC       10540065
SYSS82   LM    10,11,SYSS87                                             10540066
         NI    SYSSOC+1,X'0F'          ACCEPT NEXT ATTENTION ON 1052    10540067
         LPSW  SYSS84                  RETURN FROM OP.COM. RTN          10540068
SYSS80   CLI   35,X'04'                                                 10540069
         BE    SYSS82                  CODE 3  RETURN FROM OP.COM RTN   10540070
         BL    SYSS81                  CODE 3  RETURN FROM TIMER RTN    10540071
SYSS10   MVI   35,X'10'                 SVC CODE ERROR                  10540072
         MVC   40(8),32                 SIMULATE PROG CHECK             10540073
         B     SYSSPC                   WITH INTRT CODE 00010000        10540074
SYSS11   CLC   0(6,12),SYSSLC           COMPARE NAME WITH EOJ           10540075
SYSSAT   MVC   32(8),SYSSLB             MOVE  PROB PSW                  10540076
         BNE   SYSS09+8                 LOAD PSW                        10540077
         B     SYSS09+4                 LOAD PSW WITH WAIT STATE        10540078
SYSEXT   TM    27,X'80'                IS IT TIMER INTERRUPT            10540079
         BO    SYSSTM                  GO TO HANDLING OF TIMER INTERRUP 10540080
SYSS13   CLI   4,C'A'                   IF REPLY NOT REQUIRED           10540081
         MVI   4,C' '                                                   10540082
         BNE   SYSS15                   IGNORE THIS MSG                 10540083
         L     12,SYSSAC                                                10540084
         MVC   0(1,12),5                MOVE REPLY IN CALLING SEQUENCE  10540085
         CLI   5,C' '                                                   10540086
         BE    SYSS15                   IGNORE CODE IF BLANK            10540087
         NI    5,X'FC'                 IS CODE 0 TO 4 IN BINARY         10540088
         CLI   5,X'F0'                  OR CHARACTER FORM               10540089
         BE    SYSS17                                                   10540090
SYSS14   CLI   5,X'02'                  IF CODE 0 OR 1                  10540091
         BL    SYSS18                   GO TO ABNORMAL END OF JOB       10540092
         CLI   5,X'03'                                                  10540093
         BE    SYSS99                                                   10540094
         BL    SYSS19                   GO TO -SET 7TH BIT ON IN UPSI - 10540095
SYSS15   MVI   5,C' '                   IGNORE OR END OF MSG-REPLY      10540096
         NI    25,X'FD'                 PROCESSING                      10540097
SYSS16   LPSW  24                                                       10540098
SYSS99   NI    SYSUPS,X'FE'                                             10540099
         B     SYSS15                                                   10540100
SYSS17 MVC   5(1),0(12)                                                 10540101
         NI    5,X'0F'                           INTO BINARY FORM       10540102
         B     SYSS14                                                   10540103
SYSS19   OI    SYSUPS,X'01'            SET ON 8TH BIT OF UPSI           10540104
         B     SYSS15                                                   10540105
SYSS20   DC    H'1'                                                     10540106
SYSSTM   MVC   SYSS83(8),24            SAVE OLD PSW                     10540107
         STM   10,11,SYSS86                                             10540108
         LH    12,SYSRTA+2             IS AN USER(S RTN PROVIDED        10540109
         LTR   12,12                                                    10540110
         BZ    SYSS81                  NO - RETURN                      10540111
         STH   12,30                   YES - GO TO THIS ROUTINE         10540112
         LPSW  24                                                       10540113
SYSSOC   BC    0,SYSSCX                ACCEPT OR NOT ATTENTION ON 1052  10540114
         MVC   SYSS84(8),56            SAVE OLD PSW                     10540115
         STM   10,11,SYSS87                                             10540116
         SVC   2                       MACRO TO ASK FOR THE CODE        10540117
         DC    C'0902A '                                                10540118
         LH    12,SYSRTA+4             IS AN USER,S RTN PROVIDED        10540119
         LTR   12,12                                                    10540120
         BZ    SYSS82                  NO - RETURN                      10540121
         STH   12,62                   YES - GO TO THIS ROUTINE         10540122
         OI    SYSSOC+1,X'F0'          1052 ATTENTION NOT ACCEPTED      10540123
SYSSCX   LPSW  56                                                       10540124
         DS    0F                                                       10540125
SYSS21   DC    X'0000FFFF'              MASK FOR LOAD HALFWORD          10540126
SYSSCR   DC    F'0'                    COMMUNICATION REGION- MONTH-DAY  10540127
         DC    H'0'                                           YEAR      10540128
         DC    X'000000'                                      DATE      10540129
         DC    X'00'                                          CONFIG    10540130
SYSEND   DC    YL2(SYSSND)             END OF SUPERVISOR                10540131
SYSUSR   DC    2F'0'                   FOR USER - RESET BY SYSEOJ       10540132
         DC    3C'0'                             NOT RESET              10540133
SYSUPS   DC    X'00'                   UPSI                             10540134
SYSS26   DC    C'NAMEXX'                                                10540135
SYSRTA   DC    2FL4'0'                 PC-TIMER-OP.COM-1015 ROUTINES    10540136
         DC    X'0000'                 SYSEOJ SWITCHES                  10540137
SYSSPC   LH    13,SYSRTA                                                10540138
               CH   13,SYSS20                                           10540139
         BC    12,SYSSPD                                                10540140
               MVC  32(8),40                                            10540141
               STH  13,38                                               10540142
               LPSW 32                                                  10540143
SYSSPD         SVC  2                                                   10540144
         DC    C'0901  '               MESSAGE FOR PROG CHECK           10540145
SYSS18   CLR   13,13                    RESET COND CODE TO ZERO         10540146
         MVI   5,C' '                                                   10540147
         B     SYSS11+6                   AND BRANCH TO LOAD PROB PSW   10540148
SYSSLC   DC    C'SYSEOJ'                                                10540149
*                                                                       10540150
SYSUTB   DC    X'00000005'             SYSRES CONTAINS PUB LIMITS       10540151
       DC    X'00080801'                1402,UNIT 08,SYSRDR             10540152
       DC    X'00100602'                1403,UNIT 10,SYSLST             10540153
       DC    X'000A0403'                1442,UNIT 0A,SYSIPT             10540154
       DC    X'00040A04'                1402,UNIT 04,SYSOPT             10540155
SYSUTY DC    X'001F0200'                1052,UNIT 1F,SYSLOG             10540156
         DC    X'00000000'             SYS000                           10540157
         DC    X'00000000'             SYS001                           10540158
         DC    X'00000000'             SYS002                           10540159
         DC    X'00000000'             SYS003                           10540160
         DC    X'00000000'             SYS004                           10540161
*  *  *  TAPE BIASED SIMPLER SCHEDULER *  *  *                          10540162
SYSENS   EQU   SYSS00+24                HOLD C SENSE INFO               10540163
SYSHLD EQU   8           HOLDING AREA FOR TYPE MSG                      10540164
SYSUSE EQU   19                         BYTE SHOWS ACTIVITY ON CHANNLS  10540165
*            * * * REQUEST I/O ENTRY POINT * * *                        10540166
* * *  SPVR  LOADED REG 12  FOR ME                                      10540167
SYSXCP LH    13,0(12)                   LOAD CCB ADDRESS                10540168
* * *  NEED  AND ABOVE 32 K                                             10540169
       LA    12,2(12)                   ADD 2 TO GET RETURN ADDRESS     10540170
       STH   12,38                      STORE RETURN ADDRESS            10540171
       NC    0(5,13),SYSXZA             ZERO LINK AND COMMUNICATIONS    10540172
SYSQDE   TM    2(13),X'04'              SHOULD THIS CCB WAIT FOR DEV E  10540173
         BC    8,SYSAAA                 BYPASS STASH IN WAITING LIST    10540174
* * *    PUSH DOWN LIST OF DEVICES SIG AT DEV END                       10540175
       STH   13,SYSVCB                  STORE CCB ADDRESS               10540176
         MVC   SYSA01(SYSLNG),SYSA01+2       PUSH DOWN LIST             10540177
SYSAAA  EQU  *                                                          10540178
       STH   13,SYSVCB                  SAVE CCB ADDRESS                10540179
       LH    13,4(13)                    LOAD SYMBOLIC ADDRESS          10540180
       SR     12,12                     ZERO REGISTER                   10540181
       IC    12,SYSUTB(13)              PULL CHANNL                     10540182
       AR     12,12                     DOUBLE CHANNEL                  10540183
       OC    SYSUSE(1),SYSXCN-SYSS00(12) SET CHANNEL USE BYTE           10540184
*            * * * PLACE CCB AT END OF Q AND LINK * * *                 10540185
       LA    13,SYSQMX(12)              LOAD ADDRESS OF HEAD OF Q       10540186
SYSQLL CLI   0(13),X'00'                TEST CORE FOR BLANK ADRESS      10540187
       BC    8,SYSQLK                   END OF Q   SO PASS TO STORE CCB 10540188
       LH    13,0(13)                   PULL LINKAGE ADDRESS            10540189
     B       SYSQLL                                                     10540190
SYSQLK MVC   0(2,13),SYSVCB               PUT THIS CCB AT END OF Q      10540191
       CLI   SYSXPT-SYSS00(12),X'07'    EXPECT INTERRUPT THIS CHANNEL Q 10540192
       BNE   SYSXST                     EXIT SUPVR IF NOW EXPECT INTRPT 10540193
SYSQST MVC   56(8),32                                                   10540194
*            * * * START I/O FOR THIS Q      * * *                      10540195
SYSUA1 LH    13,SYSQMX-SYSS00(12)       PULL HEAD OF Q CCB ADDR         10540196
       MVC   74(2),6(13)                PULL CCW ADDR INTO CAW          10540197
       LH    13,4(13)                   LOAD SYMBOLIC ADDRESS           10540198
         CLI   SYSUTB-SYSS00+2(13),X'00'     IS THIS DEVICE A TAPE      10540199
         BNE   SYSWF1                   BRANCH IF NOT                   10540200
         NI    SETMOD,X'03'             SET MODE BITS OFF               10540201
         OC    SETMOD(1),SYSUTB-SYSS00+3(13)      SET MOD ON            10540202
         MVC   SYSTIC+2(2),74          PLACE CCW INTO TIC               10540203
         MVC   74(2),ADSTMD+2           PLACE SET MODE ADDR INTO CAW    10540204
SYSWF1   LH    13,SYSUTB(13)            PUT CHNL, DEVICE IN REGISTER    10540205
SYSWFH   B       SYSWIO            BYPASS WOIT                          10540206
       MVI   SYSWUP+1,X'F0'             TURN SWUP TO BRANCH             10540207
         MVI     SYSXWW+1,X'00'                                         10540208
         TIO     0(13)             CHECK CHANNEL END                    10540209
         BC      6,*-4             WAIT FOR DEVICE END                  10540210
*            * * * START I/O ROUTINE    * * *                           10540211
SYSWIO SIO   0(13)           START IO                                   10540212
       STH   13,58                      IF CSW STORED NEED CH/UN ADRES  10540213
       BC    7,*+8            BYPASS SET EX PECT                        10540214
       STH   13,SYSXPT-SYSS00(12)       MOVE CHNL,DEVICE TO 5XP53T 9N3  10540215
       BC    10,SYSXWW                  GET OUT IF CC IS 0,2            10540216
       BC    1,SYSXMN                   OVERFLO FOR NOT OPERATIONAL     10540217
         NI    SYSUIS+1,X'0F'           IMMEDIATE END                   10540218
       TM    68,X'10'                   DEVICE BUSY                     10540219
       BC    12,SYSXBB                  NO SO ERR OR IMMED END          10540220
       TM    68,X'04'                   DEVICE END                      10540221
       BC    1,SYSWIO                   TRY AGAIN D.E INT WAS PENDING   10540222
SYSXWW BC    15,SYSXIT                  BUSY BUT NO END SAYS TRY LATER  10540223
       TIO   0(13)                                                      10540224
       BC     2,*-4              WAIT FOR CHANNEL END                   10540225
       BC    15,SYSXBB                  END OF WAIT,CHECK ERRORS        10540226
*            * * * I/O INTERRUPT                                        10540227
SYSXIN SR     12,12                     ZERO REGISTER                   10540228
         OI    SYSUIS+1,X'F0'           I/O INTRPT  NOT INISL SELECTION 10540229
       IC    12,58                       INSERT CHANNEL                 10540230
       AR    12,12                      DOUBLE CHANNEL                  10540231
SYSXCK CLC   SYSXPT-SYSS00(2,12),58      EXPECT INTRUPT THIS CH,DEVICE  10540232
      BC  7,SYSXAT       TEST ATTENTION ETC                             10540233
* * *  ANALYSE FOR ERRORS, INTERRUPT OR CSW STORED                      10540234
SYSXBB LH    13,SYSQMX-SYSS00(12)       LOAD CCB ADDRESS FOR SET ERR FL 10540235
       TM    69,X'3F'                   TEST CHNNL,DATA,CONTROL,INTFACE 10540236
       BC    7,SYSQCC                   CHANNNEL ERRORS HARD STOP       10540237
SYSXCC TM    68,X'01'                   TEST UNIT EXCEPTION,END FILEETC 10540238
       BC    8,SYSXUC                   BR TO UNIT TEST UNIT CHECK      10540239
       OI    3(13),X'04'                TURN ON UNIT EXCEPTION          10540240
SYSXUC TM    68,X'02'                   UNIT CHECK                      10540241
       BC    7,SYSWUC                   YES,GO TO WORK UNIT CHECK       10540242
* * *  NO ERRORS ASSUME CHANNEL END                                     10540243
SYSUDE TM    68,X'04'                   DEVICE END                      10540244
       BC    8,SYSWUP                   NO LEAVE IT IN LITST            10540245
       OI    3(13),X'01'                SET END  DEV END BIT            10540246
SYSWUP BC    0,SYSQXC                   ER RTN CUT Q BY BRANCH HERE     10540247
       TM    69,X'80'                   PROG  CONTR INTR                10540248
       BC    8,SYSPST             NO CONTINUE                           10540249
         OI    4(13),X'80'              TURN PCI BIT ON                 10540250
         TM    69,X'08'                 CHANNEL END                     10540251
         BNE   SYSXIT                                                   10540252
SYSPST OC    2(1,13),69                 OR IN WLR,PCI  BITS             10540253
       OI    2(13),X'80'                POST TRAFFIC BIT                10540254
SYSUPD MVI   SYSXPT-SYSS00(12),X'07'    SAY CHNL NOT EXPECT INTERRUPT   10540255
       MVC   SYSQMX-SYSS00(2,12),0(13)  MOVE NEXT TO HEAD OF Q          10540256
       MVC   0(2,13),70                 PUT RESIDUAL COUNT IN CCB       10540257
SYSQTT CLI   SYSQMX-SYSS00(12),X'00'     IS Q EMPTY                     10540258
       BC    6,SYSUA1                   NO,TRY TO START I O             10540259
       NC    SYSUSE(1),SYSXCN+1-SYSS00(12) CLEAR BIT IN CHANNEL USE BY  10540260
SYSXIT LPSW  56                         RETURN VIA LOAD OLD PSW         10540261
SYSXRS XC    SYSQMX(8),SYSQMX           TURN Q A TO ZERO                10540262
       MVI   SYSXPT,X'07'               NOT EXXECT ON MPX CHANNEL       10540263
       MVC   SYSXPT+1(7),SYSXPT         NOT EXPECT ON ANY CHNNL         10540264
       MVI   SYSUSE,X'00'               SET CHANNEL ACTIVITY TO ZERO    10540265
SYSVRR MVI   SYSWUP+1,X'00'             NOP ERR I/O RETURN IF ERR CH OK 10540266
         MVI     SYSXWW+1,X'F0'         RESET BRANCH AFTER SIO          10540267
       MVI   SYSQXR+1,X'F0'             SET SWITCH TO BR AS NORMAL      10540268
       MVI   SYSWFH+1,X'F0'             SET SW TO BRANCH                10540269
       CLI   SYSWFF+1,X'00'  '             IS SWITCH TO BRANCH          10540270
       BCR   8,13                       NO, RETURN                      10540271
         LM    1,11,SYSVRX              RESTORE REGISTERS               10540272
       MVI   SYSWFF+1,X'00'             SWITCH TO SAVE PSW              10540273
       BCR   15,13                     RETURN                           10540274
*            * * * TEST UNIT CHECKS     * * *                           10540275
SYSWUC OI    2(13),X'20'                SET UNCORRECTABLE ERROR BIT CCB 10540276
       TM    2(13),X'01'                USER ERROR RTN                  10540277
       BC    1,SYSWUP                   YES,RETURN TO USER              10540278
SYSWFF BC    0,SYSXFF                   BYPASS SAVE PSW AND STATUS      10540279
SYSVRZ   STM   1,11,SYSVRX              SAVE REGISTERS FOR WORK         10540280
       LM    1,5,SYSAVE       SAVE CORE BY REG   BCR  * * *             10540281
       MVI   SYSQCT,X'0'                SERO ERROR COUNTER              10540282
SYSXFF OI    SYSWFF+1,X'F0'              TURN ON SWITCH TO BYPASS SAVE  10540283
         MVI     SYSWFH+1,X'00'    NOP  SWITCH                          10540284
       LH   11,66                       NEXT CCW     INTO REG           10540285
         SH   11,SYSC08                SUBTRACT 8 TO GET LAST CCW       10540286
       STH  11,66         SAVE NEW CCW IN CORE                          10540287
       MVC   SYSVCW(12),64               SAVE CSW,   CAW                10540288
       MVI     50,X'1F'                 1F  FOR UNIT CHECK              10540289
       XC    SYSENS(6),SYSENS           SET SENSE TO ZERO               10540290
       LH    9,58                                                       10540291
       MVC   74(2),SYSXSC                SENSE CCW                      10540292
       SIO   0(9)                       SENSE                           10540293
         BC    6,*-4                                                    10540294
* * * *      ASSUMED  NO ERRORS ON SENSE  SINCE UNIT CHECK SAYS CONTR   10540295
* * * *                UNIT IS OPERATIONAL                              10540296
* * * *      ASSUME  NO OUTSTANDING INTRPS SINCE GOT SOME KIND OF ENDA  10540297
* * * *              SHORT WHILE BACK                                   10540298
       TIO   0(9)                                                       10540299
       BC   2,*-4            WAIT FOR END OF SENSE                      10540300
       MVC   64(12),SYSVCW                   RESTORS   CSW  CAW         10540301
       IC    8,SYSQCT                   READY TO STEP COUNTER           10540302
SYSCSP LA    8,1(8)                     ADD ONT TO COUNTER              10540303
       STC   8,SYSQCT                   PUT CNTR IN CORE                10540304
       LH     8,4(13)                   PULL SYMBOLIC UNIT              10540305
       IC     8,SYSUTB+2(8)              PULL DEVICE TYPE               10540306
       LH    8,SYSXTE(8)               PULL TABLE ADDRESS               10540307
       BCR   15,8                                                       10540308
SYSQCC MVI   50,X'0F'                   CHANNEL ERROR                   10540309
       LPSW   112                       SIMULATE MACH CHECK             10540310
SYSXMN   MVI     50,X'3F'          NOT OPERATIONAL  3F                  10540311
       LH    13,SYSQMX(12)              PULL CCB ADDRESS                10540312
*            * * * DISTASTER OR DUMP EXIT * * *                         10540313
SYSQXD OI    2(13),X'20'                DISASTER BIT                    10540314
       TM    2(13),X'10'                ACCEPT BAD I/O                  10540315
       BC    1,SYSQXK                   YES  CONTINUE  NO CLEAR DISAST  10540316
* * *  DISASTER BIT ONLY BELONGS ON IF BITS X'11' I(13) ARE ON * * * *  10540317
       LPSW    112                                                      10540318
* * *  OPERATOR CHOICE EXIT                                             10540319
SYSQXP UNPK  SYSHLD(5),58(3)            PUT CH/UN REL                   10540320
SYSC08   EQU   *-4                     CONSTANT OF 8                    10540321
       UNPK  SYSHLD+4(5),SYSENS(3)      UNPACK SENSE INFO               10540322
       TR    SYSHLD(8),SYSTBL-240       CONVERT HEX TO CHARACTER FOR PR 10540323
       MVC   SYSXM1(4),SYSHLD           SET MESSG1 FOR MACRO            10540324
       MVC   SYSXM2(4),SYSHLD+4         SET MESSG2 FOR MACRO            10540325
         STM   12,13,SYSDRG             SAVE REGISTERS SINCE SUP USES T 10540326
       SVC   2           CALL VOR MESSAGE                               10540327
SYSXM1   DC    C'CHUN  '                CHANNEL AND UNIT MESSAGE        10540328
       SVC   2           CALL FOR MESSAGE                               10540329
SYSXM2   DC    C'SENSA '                SENSE MESSAGE                   10540330
         LM    12,13,SYSDRG             RESTORE SAVED REGISTER S        10540331
       CLI   SYSXM2+5,C'5'              IS REPLY RETRY                  10540332
* * *  RETRY EXIT                                                       10540333
       BC    8,SYSQXR                   GO TO RTN                       10540334
*            * ** CONTINUE EXIT         * * *                           10540335
SYSQXC NI    2(13),X'DF'                TURN OFF DISASTER BIT           10540336
SYSQXK CLI   SYSQXR+1,X'00'             WAS THIS I/O FROM RROR RTN      10540337
SYSXEE   MVI     SYSQXR+1,X'F0'    SWITCH FOR RESET OPER  SET IT TO BR  10540338
          BC     8,2(10)                   RETURN TO ERR RTN            10540339
       BAL   13,SYSVRR                 RESTORE REGISTERS                10540340
SYSWDE BC  0,SYSPDE                                                     10540341
       LH    13,SYSQMX-SYSS00(12)       LOAD CCB ADDRESS F              10540342
       BC    15,SYSWUP                  UPDATE AND CONTINUE             10540343
SYSQXR BC    15,SYSUA1                  NORMAL RETRY                    10540344
SYSQXS MVC   74(2),0(10)                LOAD CAW                        10540345
       LH    13,58          SET UP CHANNEL,UNIT ADDRESS                 10540346
       OI    SYSWUP+1,X'F0'             TURN SWUP TO BRANCH             10540347
         MVI     SYSQXR+1,X'00'    SWITCH FOR RESET OPER  NOP           10540348
         MVI     SYSWFH+1,X'00'    NOP  SWITCH                          10540349
       BC    15,SYSWFH+4                USE  NORMAL START AND TESTS     10540350
SYSSOF   TM    2(13),X'02'              TEST SELECTED ERROR BIT         10540351
         BCR   8,1                      EXIT IF NOT ON                  10540352
         B     SYSXEE                  CONTINUE IF ON                   10540353
SYSXAT   EQU  *                                                         10540354
SYSUNX   LA    12,SYSVCB                 INITIALIZE SEARCH FOR DEV END  10540355
SYSAL1   SH    12,SYSC02                 SUBTRACT 2                     10540356
         CLI   0(12),X'00'              NO CCB                          10540357
         BE    SYSA00                   NONE TRY TESTING Q              10540358
         LH    13,0(12)                 PULL CCB                        10540359
         LH    13,4(13)                 PULL SYMBOL UNIT                10540360
         CLC   SYSUTB-SYSS00(2,13),58   COMPARE INTR CR/UNIT/S CCB C/UN 10540361
         BNE   SYSAL1                   NOT THIS DEVICE                 10540362
         MVI   SYSWUP+1,X'F0'           CUT AT END OF CHECKS            10540363
         MVI   SYSWDE+1,X'F0'           RETURN HERE  DEV END SWITCH     10540364
         LH    13,0(12)                 SET CCB                         10540365
         B     SYSXBB+4                 SIGNIF.INT-CHECK CONDITIONS W/R 10540366
SYSPDE   MVI   SYSWDE+1,X'00'           NOP  DEV END SW                 10540367
         SH    12,SYSC02                POP UP LIST                     10540368
         MVC   2(2,12),0(12)            UPDATE OUTSTANDING D.E POSSIBLE 10540369
         CLI   0(12),0                  END OF SIG LIST                 10540370
         BNE   SYSPDE+4                 POP UP THE LIST                 10540371
SYSA00   SR    12,12                    SET REG 12 IF ANY SEL CH S POIN 10540372
       IC    12,58                       INSERT CHANNEL                 10540373
       AR    12,12                      DOUBLE CHANNEL                  10540374
SYSQTS CLI   SYSXPT-SYSS00(12),X'07'    AT DEVICE END  NEED TO TST EXPT 10540375
       BC    4,SYSXIT                   LESS,REALL CHANNEL NUMBER       10540376
     B     SYSQTT                                                       10540377
* * *    CHECK DEVICE END                                               10540378
SYSC02 DC  H'2'                                                         10540379
* * *    DESIGNED FOR PRTOV MACRO                                       10540380
       DC  H'0'                                                         10540381
SYSA01 DC   2H'0'                       PUSH DOWN LIST FOR DVE SIG CCB  10540382
       DC   2H'0'                                                       10540383
LAST   DC   2H'0'                                                       10540384
SYSVCB DC    H'0'                                                       10540385
L      EQU   SYSVCB-SYSA01              LINGTH OF PUSH DOWN LIST        10540386
SYSLNG EQU   SYSVCB-SYSA01              LENGTH OF PUSH DOWN LIST        10540387
* * *    IF DEVICE END SIGNIFIGANT, TEST CH9,CH12,WITH I/O ERROR RTNS.  10540388
SYSXZA DC    X'00001F000F'              MASK,AND BYTES 0-3 OFF          10540389
SYSQCT DC    X'0'                  COUNTER FOR ERROR ROUTINES           10540390
*      TABLE  OF ERROR ENTRYS           * * *                           10540391
SYSXTE DC   Y(SYSTER)           TAPE ERROR RTN                          10540392
       DC      Y(SYSUIS)                1052 TYPEWRITER  ERROR          10540393
       DC      Y(SYSUAA)                1442 READ/PCH   ERROR           10540394
       DC      Y(SYSUCG)                1403 PRINTER    ERR/R           10540395
       DC      Y(SYSUCD)                1402  READER    ERR/R           10540396
       DC      Y(SYSUCC)                1402 PUNCH,PFR  ERR/R           10540397
       DC     Y(SYSD10)           DISK ROUTINES                         10540398
       DC      Y(SYSUKA)                1015 ERROR ROUTINES             10540399
       DC      Y(SYSP00)                2671 ERROR ROUTINES             10540400
       DC      Y(SYSUAB)                1443 PRINTER   ERROR            10540401
SYSUKA EQU   SYSQXD                     NO 1015 ERROR ROUTINES          10540402
SYSD10   EQU   SYSQXD                                                   10540403
SYSP00 EQU   SYSQXD                     NO 2671 ERROR ROUTINES          10540404
SYSXSC DC      Y(SYSXSN)                ADDR OF SENSE CCW               10540405
*                                                                       10540406
SYSQMX DC    3H'0'                      HEAD Q FOR MULTPLX,2SEL         10540407
SYSMSG   DC      Y(SYSSCB-2)           POINT TO CCB FOR SVC2            10540408
SYSXCN DC    X'807F'                    OR CH USE BYTE    AND IT OFF    10540409
       DC    X'40BF'                    OR CH USE BYTE    AND IT OFF    10540410
       DC    X'20DF'                    OR CH USE BYTE    AND IT OFF    10540411
SYSXPT DC    3X'0700'                   EXPECT INTERRUPT ON CHANNL      10540412
       DC     X'0700'                                                   10540413
***   AREA FOR SAVING REGISTERS                                         10540414
SYSVRX   DS    11F                      ROOM TO SAVE REMAINING REG.     10540415
SYSDRG   DS    D                                                        10540416
SETMOD   CCW   X'03',SETMOD,X'60',80     SET MODE COMMAND               10540417
SYSTIC   DC    X'08000000'              TIC COMMAND                     10540418
ADSTMD   DC      A(SETMOD)              ADDRESS OF SET MODE COMMAND     10540419
       DC  X'00FAFBFCFDFEFF00'          TRANSLATE LETT5RS 256OR5 G+     10540420
SYSXSN CCW   X'04',SYSENS,X'20',6       SENSE BYTES I/O CCW             10540421
SYSVCW   DC    3F'0'                                                    10540422
SYSAVE DC    A(SYSQXD)                  EXIT   DISASTER                 10540423
       DC    A(SYSQXC)                  EXIT   CONTINUE                 10540424
       DC    A(SYSQXR)                  EXIT   RETRY                    10540425
       DC    A(SYSQXP)                  EXIT   OPERATOR CHOICE          10540426
       DC    A(SYSQXS)                  EXIT   START I/O FOR ADJ BACKSP 10540427
SYSTBL DC    CL16'0123456789ABCDEF'            TABLE LOOK UP FOR HEX TR 10540428
*        **********  /360 TAPE ERROR ROUTINE  **********                10540429
         DS    0D                      START PROGRAM ON DOUBLE WORD     10540430
SYSTOS   EQU   6                       EQU TO GEN REG 6                 10540431
SYSTOT   EQU   7                       EQU TO GEN REG 7                 10540432
SYSTIO   EQU   10                      EQU TO GEN REG 10                10540433
SYSTIA   EQU   11                      EQU TO GEN REG 11                10540434
SYSTOP   EQU   13                      EQU TO GEN REG 13                10540435
SYST22   DC    X'2700000140000001'     BACKSPACE CCW + CHAIN FLAG       10540436
SYST33   DC    X'1700000100000001'     ERASE GAP CCW                    10540437
SYST44   DC    X'3700000100000001'     FWD, BKSP OR NOP CCW             10540438
SYST55   CCW   X'04',SYST66,X'20',2    SENSE CCW                        10540439
SYST66   DC    H'0'                    SENSE READ IN AREA               10540440
SYSTER   TM    SYSENS,X'FF'            ANY SENSE DATA                   10540441
         BCR   8,SYSUXC                                                 10540442
         MVI   SYST44,X'27'            MODIFY CCW TO BKSP               10540443
         TM    SYSENS,X'22'            BUS OUT CHECK OR WORD COUNT ZERO 10540444
         BC    5,SYST10                                                 10540445
         BAL   SYSTIO,SYSTSE           GO TO SUB-ROUT.--EQUIP + INT REQ 10540446
         MVN   SYST44+3(1),0(SYSTIA)   GET OP CODE FROM CCW COMMAND     10540447
         NI    SYST44+3,X'07'          REMOVE MOD BIT IF RD BKWD COMMD  10540448
         TM    SYSENS,X'0C'            TEST FOR DATA OR OVERRUN CHECK   10540449
         BC    7,SYST01                                                 10540450
         TM    3(13),X'08'              TEST DATA CONVERTOR             10540451
         BZ    SYST11                   NO                              10540452
         OI    3(SYSTOP),X'08'          SET DATA CONVERTOR              10540453
       BR      SYSUXC                                                   10540454
SYST01   CLI   SYST44+3,X'04'          IS THIS A RD BKWD COMMAND        10540455
         BC    7,SYST02                NO,                              10540456
         MVI   SYST44,X'37'            YES, MODIFY CCW TO FRDSPACE      10540457
SYST02   TM    SYSENS,X'04'            IS THIS AN OVERRUN CONDITION     10540458
         BO    SYST03                  YES                              10540459
         TM  SYSENS+1,X'80'             NOISE RECORD                    10540460
         BC   1,SYSTXY                                                  10540461
         LH    7,6(11)                  PLACE ORIG CT IN 7              10540462
         SH   7,70    SUB  RESID  CT                                    10540463
         LA    6,12                                                     10540464
         CR    7,6                                                      10540465
         BCR   4,SYSUXR                 RETRY  NOISE REC IF CT LESS 12  10540466
SYSTXY   CLI   SYST44+3,X'01'          IS THIS A WRITE OPER             10540467
         BZ    SYST05                  YES                              10540468
         TM    SYSQCT,X'07'            HAS 8 ATTEMPTS BEEN TRIED        10540469
         BZ    SYST06                  YES                              10540470
         TM    SYSENS+1,X'10'          IS THIS A 7 TRACK OPER           10540471
         BO    SYST03                  YES                              10540472
         TM    SYSENS+2,X'FF'          HAS TRACK IN ERROR BEEN IDENT    10540473
         BC    7,SYST03                NO                               10540474
         BALR  SYSTIO,SYSUXS                                            10540475
         DC      Y(SYST44)                REQUEST EXECUTED              10540476
         MVI   SYST44,X'1B'            MODIFY CCW OP TO REQUEST TIE     10540477
SYST03   CLI   SYSQCT,100                                               10540478
         BC    10,SYST04               YES                              10540479
         BALR  SYSTIO,SYSUXS                                            10540480
         DC      Y(SYST44)                REQUEST EXECUTED              10540481
SYSTBS   STH   SYSTIA,SYSTDC            CCW ADDRESS IS PLACED IN RETURN 10540482
         BALR  SYSTIO,SYSUXS                                            10540483
SYSTDC   DC      Y(SYSTDC)              WITH NEW CCW                    10540484
       BR    SYSUXC                     CONTINUE                        10540485
SYST04   TM    SYSENS,X'04'            TEST FOR OVERRUN CONDITION       10540486
         BCR   1,SYSUXD                                                 10540487
         OI    3(SYSTOP),X'10'          SET UNCORRECTABLE RD ERR        10540488
         B     SYSSOF                                                   10540489
SYST05   BALR  SYSTIO,SYSUXS                                            10540490
         DC      Y(SYST22)                ERASE GAP                     10540491
         CLI   SYSQCT,4                TEST FOR 3 WRITE ATTEMPTS        10540492
         BCR   4,SYSUXR                                                 10540493
         MVI   SYSENS+1,X'F3'          INIT '3 WRITE ERRORS' MESSG.     10540494
         BR    SYSUXD                                                   10540495
SYST06   MVI   SYST44,X'27'            ROUTINE                          10540496
         LA    SYSTOS,3                 TO                              10540497
         LH    SYSTOT,SYST44+2           INCORPORATE                    10540498
SYST07   BALR  SYSTIO,SYSUXS                                            10540499
         DC      Y(SYST44)                 CLEANING                     10540500
         BALR  SYSTIO,SYSUXS                                            10540501
         DC      Y(SYST55)                   WHEN                       10540502
         TM    SYST66+1,X'08'                 EVER                      10540503
         BO    SYST08                          8                        10540504
         BCT   SYSTOS,SYST07                    READ                    10540505
SYST08   XI    SYST44,X'10'                      ERRORS                 10540506
         SR    SYSTOT,SYSTOS                      ARE                   10540507
         BCR   8,SYSUXR                                                 10540508
SYST09   BALR  SYSTIO,SYSUXS                                            10540509
         DC      Y(SYST44)                                              10540510
         BCT   SYSTOT,SYST09                                            10540511
         B     SYSTBS                  EXIT TO RETRY                    10540512
SYST10   CLI   SYSQCT,3                TEST COUNTER FOR 3 ATTEMPTS      10540513
         BCR   10,SYSUXD                                                10540514
         TM      SYSENS,X'02'           READ CT ZERO                    10540515
         BCR   1,SYSUXR                                                 10540516
         CLI   SYST44+3,X'01'          IS COMMAND A WRITE OPER          10540517
         BCR   7,SYSUXR                                                 10540518
         B     SYST03                                                   10540519
SYST11   CLI   SYST44+3,3              TEST FOR SET MODE COMMAND        10540520
         CLI   SYST44+3,3              TEST FOR SET MODE COMMAND        10540521
         BCR   8,SYSUXD                                                 10540522
         BR    SYSUXP                                                   10540523
*                                                                       10540524
SYSUXD EQU   1         REGISTER 1     DISASTER                          10540525
SYSUXC EQU   2           REGISTER 3  NO ERROR  CONTINUE                 10540526
SYSUXR EQU   3           REGISTER 3  RETRY THE LAST CCB                 10540527
SYSUXP EQU   4          GREGISTER 4   OPERATOR CHOICE                   10540528
SYSUXS EQU   5           REGISTER 5  ROUTINE FOR RESET,BACKSPACE,ETC    10540529
SYSTSE   TM      SYSENS,X'10'      EQUITMENT CHECK                      10540530
         BCR     1,SYSUXD                                               10540531
SYSTSO   TM      SYSENS,X'40'      OPERATIO INTERVENTION                10540532
         BCR     1,SYSUXP          GO TO OPERATIO  CHOICE               10540533
         BR    10                                                       10540534
***** ERROR ROUTINE FOR PRINTERS,READERS AND PUNCH FOR TAPE SYSTEM ***  10540535
SYSTSU   TM    SYSENS,X'58'                                             10540536
         BCR   5,SYSUXP                                                 10540537
SYSUBT TM    SYSENS,X'20'               BASIC TEST ROUTINE     BUSS OUT 10540538
       BC    1,SYSUIS                   BUS OUT,SWITCH FOR RETRY        10540539
       TM    SYSENS,X'80'               COMMAND REJECT                  10540540
       BCR   1,SYSUXD                   GO TO DISASTER                  10540541
       BR    10                         NONE OF THESE  RETURN TO DEV RT 10540542
***** ENTER ROUTINE HERE FOR 1402 PUNCH ERROR *****                     10540543
SYSUCC TM    SYSENS,X'10'               EQUIPMENT CHECK                 10540544
       BC    8,SYSUCD                   NO,USE 1402R ROUTINES           10540545
SYSUDA   OI    3(13),X'11'             SET BIT IN CCB                   10540546
         B     SYSSOF                   EXIT TO TEST SOFT ERR BIT       10540547
***** ENTER ROUTINE HERE FOR 1402 READER ERROR *****                    10540548
SYSUCD   NI    SYSUIS+1,X'0F'           KNOW CAN RETRY BUS OUT ON 1402  10540549
       BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10540550
SYSUDB   OI       3(13),X'08'     SET BIT IN CCB                        10540551
         BR    SYSUXC             BRANCH TO CONTINUE                    10540552
***** ENTER ROUTINE HERE IF 1403 OR 1404 ERROR *****                    10540553
SYSUCG BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10540554
       TM    SYSENS,X'02'               USUSUAL COMMAND SEQUENCE        10540555
       BC    1,SYSUDB                   USE POSTING RTN                 10540556
       OI    3(13),X'02'                SET CH 9 OVERFLOW BIT           10540557
         BC    15,SYSUDE                CONTINUE                        10540558
***** ENTER ROUTINE HERE IF 1442,2520 OR 2501 ERROR *****               10540559
SYSUAA BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10540560
         BR      SYSUXP           BRANCH TO OPERATOR CHOICE             10540561
***** ENTER ROUTINE HERE FOR 1443         ERROR *****                   10540562
*      1403  ALSO- COULD B UCG+4 * * *                                  10540563
SYSUAB   NI   SYSENS,X'F3'                                              10540564
       BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10540565
         TM    SYSENS,X'01'                                             10540566
         BCR   8,SYSUXC                                                 10540567
       OI    3(13),X'02'                SET BIT IN CCB                  10540568
         BC    15,SYSUDE                                                10540569
***** ENTER ROUTINE HERE FOR 1052 ERROR ALSO COMMON BUS-OUT ROUTINE     10540570
SYSUIS BCR   15,SYSUXP                  OPERATOR CHOICE IF COMMAND EXEC 10540571
       CLI   SYSQCT,3                   TRIED 3 TIMES                   10540572
       BCR   12,SYSUXR                  RETRRY                          10540573
       BR    SYSUXP                     OPERATIOR CHOICE                10540574
SYSSND EQU   *        ENS OF SUPERVISOR                                 10540575
*                                                                       10540576
ABSLUT     SVC   0                                                      10540577
SYSLDR EQU   ABSLUT                                                     10540578
READCD  EQU  ABSLUT                                                     10540579
           DC    YL2(CCCB)                                              10540580
       TM    CCCB+2,X'80'       WAIT FOR END                            10540581
       BZ   *-4                                                         10540582
TEXTCD     EQU   *                                                      10540583
       L     15,INPUT                  3 TESTS CHEAPER WITH REGISTER    10540584
       CL    15,CREP                                                    10540585
       BZ    REPRUT                                                     10540586
           L     14,INPUT+4              SET UP ADDRESS EITHER BR OR DA 10540587
       CL    15,CEND                                                    10540588
       BCR   8,14               END CARD, GOT TO ADDRESS                10540589
       CL    15,CTXT                                                    10540590
       BC    7,READCD                  NOT  ANDY LIGIT CZRD IGNORE IT   10540591
           LH    15,INPUT+10            COUNT                           10540592
TXTCNT  BCTR  15,0       REDUCE COUNT BY 1                              10540593
           STC   15,MOVETX+1                                            10540594
MOVETX     MVC   0(0,14),INPUT+16        MOVE DATA                      10540595
       B     READCD                                                     10540596
REPRUT TR    INPUT+6(6),SYSTBL-240      BYTE TO HEX   C1 = FA  ETC      10540597
       PACK  INPUT(5),INPUT+6(7)          ADDRESS TO HEX                10540598
       LA    14,INPUT+11                FROM ADDRESS  FIRST REPLACE     10540599
       LA    15,INPUT+16                INTO ADDRESS  FIRST REPLACE     10540600
REPLP  LA    14,5(14)                   ADD 5 TO FROM ADDRESS           10540601
       MVC   SAVE(4),0(14)              SAVE  4 BYTES                   10540602
       TR    SAVE(4),SYSTBL-240         BYTE TO HEX                     10540603
       PACK   0(3,15),SAVE(5)           PACK, DROP SIGN  ZONES          10540604
       LA    15,2(15)                   MODIFY INTO ADDR                10540605
       CLI   4(14),C','                 IS IT COMMA  LAST MUST BE BLANK 10540606
       BC    8,REPLP                    YES, MORE BYTES                 10540607
REPXT  SH    15,REPRUT+18               COUNT OF BYTES REPLACES         10540608
       L     14,INPUT                   ADDRESS OF FIRST BYTE           10540609
       B     TXTCNT                                                     10540610
SAVE   DC    X'00000000'    ROOM FOR PACK  ETC                          10540611
INPUT      DS    10D                                                    10540612
MSCCW3     DC    X'02'             READ                                 10540613
            DC   AL3(INPUT)                                             10540614
           DC    A(80)                                                  10540615
CTXT       DC    X'02E3E7E3'                                            10540616
CEND       DC    X'02C5D5C4'                                            10540617
CCCB       DC    F'0'                                                   10540618
           DC    H'4'                                                   10540619
           DC    YL2(MSCCW3)                                            10540620
CREP   DC    X'02'                                                      10540621
       DC    C'REP'                                                     10540622
JOBCT      LPSW  SYSSLB                                                 10540623
       END  JOBCT                                                       10540624
         TITLE 'JOB CONTROL'                                            10540625
NRSUP    START 0                                                        10540626
         USING *,0,4                                                    10540627
SJW4RG   EQU   1                                                        10540628
SJCCRG   EQU   2                        CARD INDEX REGISTER             10540629
SJCTRG   EQU   4                        COUNTING REGISTER               10540630
SJW1RG   EQU   5                        WORK REGISTER                   10540631
SJW2RG   EQU   6                        WORK REGISTER                   10540632
SJW3RG   EQU   7                        WORK REGISTER                   10540633
SJTBRG   EQU   8                        TABLE INDEX REGISTER            10540634
SJCRRG   EQU   9              CONTAINS ADDR OF START OF COMMUNICAT REG  10540635
SJFBRG   EQU   10                  CONTAINS ADDR OF FILL BUCKET ROUTINE 10540636
SJSBRG   EQU   11                  CONTAINS ADDR OF SKIP BLANKS ROUTINE 10540637
SJBRRG   EQU   14                       SUBROUTINE ADDR REGISTER        10540638
SJLKRG   EQU   15                       RETURN LINKAGE REGISTER         10540639
SJCRJB   EQU   38                  JOB CONTROL BYTE IN COMMUN. REGION   10540640
SJCRJC   EQU   39                  JOB CONTROL BYTE IN COMMUN. REGION   10540641
SJCRUP   EQU   23                  UPSI BYTE                            10540642
SJCRCF   EQU   9                   CONFIGURATION BYTE                   10540643
SJCRMO   EQU   0                   MONTH-2 BYTES                        10540644
SJCRDA   EQU   2                   DAY-2BYTES                           10540645
SJCRYR   EQU   4                   YEAR-5BYTES                          10540646
SJCRNM   EQU   24                  NAME-6BYTES                          10540647
SJCRUS   EQU   20                                                       10540648
         ORG   NRSUP+4096                                               10540649
START    BALR  3,0                                                      10540650
         USING *,3                                                      10540651
         LH    SJCRRG,20     SET CRREG TO ADDR OF COMM. REGION          10540652
         LA    SJFBRG,SJFLBK       INIT REG TO ADDR OF FILL BUCKET ROUT 10540653
         LA    SJSBRG,SJSKBL       INIT REG TO ADDR OF SKIP BLANKS ROUT 10540654
         MVI   SJCRUP(SJCRRG),X'00'    ZERO UPSI BYTE                   10540655
         MVC   SJEOJM+6(6),SJCRNM(SJCRRG)        PUT NAME IN EOJ MESG   10540656
         TM    SJCRJB(SJCRRG),X'02'          IS JOB FLAG ON             10540657
         BC   14,SJNEOJ                      BRANCH NOT EQUAL           10540658
         TM    SJCRJB(SJCRRG),X'80'          IS LOG FLAG ON             10540659
         BC   14,SJNEOJ                                                 10540660
         MVI   SJEOJM,C'N'                   INIT FOR NORMAL EOJ  MSG   10540661
         TM    SJCRJB(SJCRRG),X'01'          WAS JOB ABORTED            10540662
         BC   14,SJTEOJ                                                 10540663
         MVI   SJEOJM,C'A'                   INIT FOR ABNORMAL EOJ MSG  10540664
SJTEOJ   SVC   0                             WRITE EOJ MESSAGE          10540665
         DC    YL2(SJECCB)                                              10540666
         TM    SJECCB+2,X'80'                                           10540667
         BC    8,*-4                                                    10540668
SJNEOJ   NI    SJCRJB(SJCRRG),X'80'          RESET ALL BUT LOG FLAG     10540669
         MVC   SJCRUS(3,SJCRRG),SJNUMT                                  10540670
SJREAD   SR    SJCTRG,SJCTRG                                            10540671
         SR    SJW1RG,SJW1RG                                            10540672
         SR    SJW2RG,SJW2RG                                            10540673
         SR    SJW3RG,SJW3RG                                            10540674
         SR    SJW4RG,SJW4RG                                            10540675
         BAL   SJLKRG,SJRDCD                                            10540676
         CLC   SJINPT(3),SJKCTL         TEST IF CONTROL CARD            10540677
         BNE   SJNOSL                  GO TO NO SLASH ROUTINE           10540678
         BAL   SJLKRG,SJDISP                                            10540679
         LA    SJCCRG,SJINPT+2                                          10540680
         BALR  SJLKRG,SJSBRG                                            10540681
         BALR  SJLKRG,SJFBRG                                            10540682
         SR    0,0                                                      10540683
         CLI   SJBUCK+5,C' '            IS VERB GREATER THAN 5 CHAR     10540684
         BNE   SJNOCC                                                   10540685
         CLI   0(SJCCRG),C','           DID COMMA FOLLOW THE VERB       10540686
         BE    SJNOCC                                                   10540687
SJNOBR   BC    0,SJVOL1                NOP-BRANCH SWITCH                10540688
         CLC   SJBUCK(5),SJKPAU         TEST FOR PAUSE CARD             10540689
         BE    SJPAUS                                                   10540690
         CLC   SJBUCK(4),SJKJOB         TEST FOR JOB CARD               10540691
         BE    SJJOB                                                    10540692
         CLC   SJBUCK(4),SJKLOG                                         10540693
         BE    SJLOG                                                    10540694
         CLC   SJBUCK(5),SJKNLG             TEST FOR NOLOG CARD         10540695
         BE    SJNLOG                                                   10540696
         TM    SJCRJB(SJCRRG),X'02'     TEST JOB CARD FLAG              10540697
         BZ    SJNOJC                                                   10540698
         LA    SJTBRG,SJTABL       SET REG TO BEGIN OF CTL CD TABLE     10540699
SJCCLU   CLC   2(5,SJTBRG),SJBUCK       COMPARE TABLE ENTRY             10540700
         BE    SJFND                                                    10540701
         CLC   2(5,SJTBRG),SJKASG       TEST FOR END OF TABLE           10540702
         BE    SJNOCC                                                   10540703
         LA    SJTBRG,7(SJTBRG)         INCREMENT FOR NEXT TABLE ENTRY  10540704
         B     SJCCLU                   LOOP FOR NEXT TABLE ENTRY       10540705
SJFND    MVC   SJBCK1(2),0(SJTBRG)                                      10540706
         LH    SJBRRG,SJBCK1            LOAD REG WITH ROUTINE ADDR      10540707
         BR    SJBRRG                   BRANCH TO ROUTINE               10540708
SJRDCD   LA    SJCCRG,SJINPT            INIT CONTROL CARD REGISTER      10540709
         SVC   0                                                        10540710
         DC    YL2(SJCCB)                                               10540711
SJRD1    TM    SJCCB+2,X'80'                                            10540712
         BC    8,SJRD1                                                  10540713
         TM    SJCCB+3,X'04'           TEST EOF                         10540714
         BC    1,SJRDCD                YES-LET IOCS ISSUE MESSAGE       10540715
         BR    SJLKRG                                                   10540716
SJSKBL   CH    SJCCRG,SJEOC            TEST FOR END OF CARD             10540717
         BCR   10,SJLKRG                                                10540718
         CLI   1(SJCCRG),C' '          COMPARE FOR BLANK                10540719
         BNE   0(SJLKRG)                RETURN                          10540720
         LA    SJCCRG,1(SJCCRG)                                         10540721
         B     SJSKBL                                                   10540722
SJFLBK   MVC   SJBUCK,SJ9BLK           BLANK BUCKET                     10540723
         AH    0,SJK01                                                  10540724
         LA    SJW1RG,SJBUCK                                            10540725
SJFB1    CLI   1(SJCCRG),C' '           TEST FOR BLANK                  10540726
         BE    SJBKFL                                                   10540727
         CLI   1(SJCCRG),C','           TEST FOR COMMA                  10540728
         BE    SJBKFL                                                   10540729
         CH    SJCCRG,SJEOC                                             10540730
         BCR   8,SJLKRG                                                 10540731
         CH    SJW1RG,SJEOB             TEST FOR OVERFLOW OF BUCKET     10540732
         BE    SJFB2                                                    10540733
         MVC   0(1,SJW1RG),1(SJCCRG)                                    10540734
         LA    SJW1RG,1(SJW1RG)                                         10540735
SJFB2    LA    SJCCRG,1(SJCCRG)                                         10540736
         B     SJFB1                                                    10540737
SJBKFL   LA    SJCCRG,1(SJCCRG)                                         10540738
         BR    SJLKRG                                                   10540739
SJCNVB   BALR  SJLKRG,SJSBRG            SKIP BLANKS                     10540740
         BALR  SJLKRG,SJFBRG            FILL BUCKET                     10540741
         CLI   SJBUCK+8,C' '                                            10540742
         BNE   SJCCER                                                   10540743
         CLI   0(SJCCRG),C' '           DID BLANK STOP THE SCAN         10540744
         BNE   SJCCER                                                   10540745
         LH    SJCTRG,SJK008            SET COUNTER TO 8                10540746
         LA    SJTBRG,SJBUCK+7          SET REG TO END OF BUCKET ADDR   10540747
         SR    SJW2RG,SJW2RG            ZERO WORK REG                   10540748
SJCVB1   IC    SJW2RG,0(SJTBRG)         PUT ONE CHAR OF PARAM INTO REG  10540749
         CLI   0(SJTBRG),C'1'           IS CHAR A 1                     10540750
         BE    SJCVB2                                                   10540751
         SRL   SJW3RG,1                 SHIFT ODD REG INSERTING A ZERO  10540752
         B     SJCVB3                                                   10540753
SJCVB2   SRDL  SJW2RG,1            PUT A 1 IN HIGH ORDER OF ODD REG     10540754
SJCVB3   BCTR  SJTBRG,0                 SUBTRACT 1 FROM BUCKED ADDR REG 10540755
         BCT   SJCTRG,SJCVB1            LOOP 7 TIMES                    10540756
         SRL   SJW3RG,24           SHIFT HIGH BYTE TO LOW ORDER OF REG  10540757
         BR    SJBRRG                   RETURN TO CONFG OR UPSI ROUTINE 10540758
SJCONF   BAL   SJBRRG,SJCNVB            CONVERT 8 CHARS TO ONE BYTE     10540759
         STC   SJW3RG,SJCRCF(SJCRRG)         STORE CONFG BYTE IN CR     10540760
         B     SJREAD                   GET NEXT CARD                   10540761
SJUPSI   BAL   SJBRRG,SJCNVB            CONVERT 8 CHARS TO ONE BYTE     10540762
         STC   SJW3RG,SJUPSS+1         STORE CHAR IN MASK               10540763
SJUPSS   OI    SJCRUP(SJCRRG),0        OR UPSI CHAR TO UPSI BYTE        10540764
         B     SJREAD                                                   10540765
SJJOB    TM    SJCRJB(SJCRRG),X'02'          IS JOB FLAG ON             10540766
         BC    1,SJJOB1                      IF ON,GO TO ERROR          10540767
         BALR  SJLKRG,SJSBRG                 SKIP BLANKS                10540768
         BALR  SJLKRG,SJFBRG                 FILL BUCKET                10540769
         MVC   SJCRNM(6,SJCRRG),SJBUCK       MOVE NAME INTO CR          10540770
         OI    SJCRJB(SJCRRG),X'02'          SET JOB FLAG ON            10540771
         B     SJREAD                                                   10540772
SJJOB1   NI    SJCRJB(SJCRRG),X'FD'     RESET JOB CARD FLAG             10540773
         MVC   SJMESG+3(3),SJMSG1       SET UP MESSAGE FOR DOP JOB CARD 10540774
         B     SJMESG                                                   10540775
SJPAUS   TM    SJCRJB(SJCRRG),X'02'     TEST JOB CARD FLAG              10540776
         BC    8,SJPAU1                                                 10540777
         OI    SJCRJB(SJCRRG),X'04'     SET PAUSE FLAG ON               10540778
         B     SJREAD                                                   10540779
SJPAU1   MVC   SJMESG+3(3),SJPMSG       INIT PAUSE MESSAGE              10540780
         B     SJMESG                                                   10540781
SJEXEC   EQU   *                                                        10540782
         LH    SJW1RG,22     POINT REG TO SYSLST PUB                    10540783
         LA    SJW1RG,08(SJW1RG)                                        10540784
         NI    SJCRJC(SJCRRG),X'7F'    RESET PRINTER SW                 10540785
         CLI   2(SJW1RG),X'06'         IS SYSLST A PRINTER              10540786
         BE    SJSPS                                                    10540787
         CLI   2(SJW1RG),X'12'                                          10540788
         BNE   SJEXQ1                                                   10540789
SJSPS    OI    SJCRJC(SJCRRG),X'80'          SET PRINTER SW             10540790
SJEXQ1   CLI   SJCRDA(SJCRRG),X'00'     TEST IF DATE WAS SUBMITTED      10540791
         BE    SJNODC                                                   10540792
         TM    SJCRJB(SJCRRG),X'04'     TEST PAUSE FLAG                 10540793
         BC    8,SJEXQ2                                                 10540794
         SVC   2                             DELAYED PAUSE              10540795
         DC    C'1703A '                                                10540796
SJEXQ2   EQU   *                                                        10540797
SJEXQ3   LH    SJW3RG,20               GET                              10540798
         NC    SJLBKT(1),9(SJW3RG)     HIGHEST                          10540799
         LH    SJW3RG,SJKON8           CORE                             10540800
         IC    0,SJLBKT                LOCATION                         10540801
         SRL   0,5                                                      10540802
         STC   0,*+7                                                    10540803
         SLL   SJW3RG,0                                                 10540804
         BCTR  SJW3RG,0                                                 10540805
         MVI   0(SJW3RG),C'*'                                           10540806
SJLAB3   BC    0,SJMLAB                                                 10540807
SJEXQ6   CLI   19,X'00'                ARE ALL I/O FINISHED             10540808
         BNE   SJEXQ6                                                   10540809
         SVC   1                        FETCH PROGRAM                   10540810
SJEXQ4   DC    C'SYSBPD'                                                10540811
SJDATE   BALR  SJLKRG,SJSBRG            SKIP BLANKS IN CTL CARD         10540812
         BALR  SJLKRG,SJFBRG            FILL BUCKET WITH DATE           10540813
* TEST FOR NON-NUMERIC CHARACTER IN DATE FIELD                          10540814
         MVC   SJBCK1(5),SJBUCK         PUT DATE IN TEMP BUCKET         10540815
         NC    SJBCK1(5),SJK5F0         CONVERT BYTES TO XXXX0000       10540816
         CLC   SJBCK1(5),SJK5F0         TEST IF XXXX0000 ARE 11110000   10540817
         BNE   SJCCER                   IF NO THERE IS A NON NUMERIC    10540818
         MVC   SJBCK1(5),SJBUCK         PUT DATE IN TEMP BUCKET         10540819
         NC    SJBCK1(5),SJK50F         CONVERT BYTES TO 0000XXXX       10540820
         TRT   SJBCK1(5),SJNUMT         TEST IF ANY NUMBER IS NOT 0-9   10540821
         BC    6,SJCCER                                                 10540822
         CLI   SJBUCK+5,C' '       IS DATE FIELD LONGER THAN 5 CHAR     10540823
         BNE   SJCCER                                                   10540824
         CLI   SJBUCK+4,C' '            IS DATE LESS THAN 5 CHAR        10540825
         BE    SJCCER                                                   10540826
         MVC   SJCRYR(5,SJCRRG),SJBUCK       STORE 5 CHAR DATE IN CR    10540827
         PACK  SJBCK1(8),SJBUCK(2)      PACK THE YEAR                   10540828
         CVB   SJW1RG,SJBCK1            CONVERT TO BINARY THE YEAR      10540829
         MVI   SJFEB,X'1C'             SET FEB TABLE ENTRY TO 28 DAYS   10540830
         N     SJW1RG,SJKW3             AND 0003 TO TEST FOR LEAP YEAR  10540831
         BNE   SJDAT1                                                   10540832
         MVI   SJFEB,X'1D'              SET FEB TABLE ENTRY TO 29 DAYS  10540833
SJDAT1   PACK  SJBCK1(8),SJBUCK+2(3)    PACK THE DAY                    10540834
         CVB   SJW1RG,SJBCK1            CONVERT THE DAY TO BINARY       10540835
         XR    SJCTRG,SJCTRG                                            10540836
         LA    SJTBRG,SJMOTB-1     SET TABLE REGISTER TO ADDR OF MO T12 10540837
SJDAT2   LA    SJCTRG,1(SJCTRG)         ADD ONE TO MONTH COUNTER        10540838
         LA    SJTBRG,1(SJTBRG)         ADD 4 TO TABLE REG              10540839
         STC   SJW1RG,SJDAT             SAVE DATE                       10540840
         IC    SJW2RG,0(SJTBRG)                                         10540841
         SR    SJW1RG,SJW2RG            SUBTRACT MONTH VALUE FROM DATE  10540842
         BP    SJDAT2                   LOOP ON A PLUS RESULT           10540843
         CVD   SJCTRG,SJBCK1            CONVERT MONTH COUNT TO DEC      10540844
         UNPK  SJCRMO(2,SJCRRG),SJBCK1(8)         STORE MONTH IN CR     10540845
         IC    SJCTRG,SJDAT                                             10540846
         CVD   SJCTRG,SJBCK1            CONVERT DAY TO DEC              10540847
         UNPK  SJCRDA(2,SJCRRG),SJBCK1(8)         STORE DAY IN CR       10540848
         OI    SJCRMO+1(SJCRRG),X'F0'                                   10540849
         OI    SJCRDA+1(SJCRRG),X'F0'                                   10540850
         CLC   SJCRMO(2,SJCRRG),SJK12        IS MONTH MORE THAN 12      10540851
         BNH   *+14                                                     10540852
         MVC   SJCRMO(9,SJCRRG),SJNUMT       ZERO DATE FIELD            10540853
         B     SJCCER                                                   10540854
         B     SJREAD                                                   10540855
SJNODC   MVC   SJMESG+3(3),SJNDCM       SET UP MESSAGE FOR NO DATE CARD 10540856
         B     SJMESG                                                   10540857
SJSYSR   BALR  SJLKRG,SJFBRG            PUT SYS*** PARAM INTO BUCKET    10540858
         CLI   0(SJCCRG),C','           TEST FOR COMMA AFTER PARAM 1    10540859
         BNE   SJCCER                                                   10540860
         CLI   SJBUCK+6,C' '                                            10540861
         BNE   SJCCER                                                   10540862
         CLC   SJBUCK(3),SJKSYS                                         10540863
         BNE   SJCCER                                                   10540864
         LA    SJW4RG,4                 PUT DISP FOR SYSRDR IN REG      10540865
         CLC   SJBUCK+3(3),SJKRDR       TEST FOR SYSRDR                 10540866
         BCR   8,SJBRRG                 BRANCH EQUAL                    10540867
         LA    SJW4RG,4(SJW4RG)                                         10540868
         CLC   SJBUCK+3(3),SJKLST       SYSLST                          10540869
         BCR   8,SJBRRG                 BRANCH EQUAL                    10540870
         LA    SJW4RG,4(SJW4RG)                                         10540871
         CLC   SJBUCK+3(3),SJKIPT       SYSIPT                          10540872
         BCR   8,SJBRRG                 BRANCH EQUAL                    10540873
         LA    SJW4RG,4(SJW4RG)                                         10540874
         CLC   SJBUCK+3(3),SJKOPT       SYSOPT                          10540875
         BCR   8,SJBRRG                 BRANCH EQUAL                    10540876
         LA    SJW4RG,4(SJW4RG)                                         10540877
         CLC   SJBUCK+3(3),SJKLOG       SYSLOG                          10540878
         BCR   8,SJBRRG                 BRANCH EQUAL                    10540879
         CLI   SJBUCK+5,C' '                                            10540880
         BE    SJCCER                                                   10540881
         TM    SJBUCK+3,X'F0'           TEST FOR NON NUMERIC ERROR      10540882
         BC    14,SJCCER                                                10540883
         TM    SJBUCK+4,X'F0'                                           10540884
         BC    14,SJCCER                                                10540885
         TM    SJBUCK+5,X'F0'                                           10540886
         BC    14,SJCCER                                                10540887
         PACK  SJBCK1(8),SJBUCK+3(3)    PACK INTO FULL WORD             10540888
         CVB   SJW1RG,SJBCK1            CONV PUB NO TO BINARY           10540889
         LA    SJW1RG,1(SJW1RG)        ALLOW FOR PUB 000                10540890
         STC   SJW1RG,SJSYS1+1                                          10540891
         LH    SJW2RG,22                LOAD PUB ADDR IN WORK REG       10540892
SJSYS1   CLI   3(SJW2RG),X'00'          IS THIS PUB IN THIS SYSTEM      10540893
         BL    SJCCER                                                   10540894
         SLL   SJW1RG,2                 MULT PUB NO BY 4                10540895
         AR    SJW4RG,SJW1RG            ADD PUB DISP TO TABLE REG       10540896
         BR    SJBRRG                                                   10540897
SJASGN   BALR  SJLKRG,SJSBRG            SKIP BLANKS AFTER VERB          10540898
         BAL   SJBRRG,SJSYSR                                            10540899
         AH    SJW4RG,22                                                10540900
SJASG2   BAL   SJLKRG,SJFLBK                                            10540901
         XC    SJPUB(4),SJPUB                                           10540902
         CLC   SJBUCK(3),SJKUA         SHOULD PUB BE UNASSIGNED         10540903
         BE    SJASG5                  LOAD EMPTY PUB                   10540904
         CLC   SJBUCK+5(2),SJKQB        TEST IF PAR2 IS X'XXX'          10540905
         BNE   SJCCER                                                   10540906
         CLC   SJBUCK(2),SJKHEX                                         10540907
         BNE   SJCCER                                                   10540908
         CLI   SJBUCK+2,C'2'            IS CHAN GREATER THAN 2          10540909
         BH    SJCCER                                                   10540910
         MVC   SJPUB(1),SJBUCK+2        STORE CHAN IN TEMP PUB          10540911
         NI    SJPUB,X'0F'              CONV CHAN NUMBER TO BINARY      10540912
         MVC   SJBCK1(2),SJBUCK+3       PLACE HEX CHARS IN BUCKET       10540913
         BAL   SJLKRG,SJCVHB            GO TO CONV HEX TO BINARY ROUTIN 10540914
         STC   SJW2RG,SJPUB+1           STORE UNIT NO IN TEMP PUB       10540915
         BAL   SJLKRG,SJFLBK                                            10540916
         CLI   SJBUCK+2,C' '            TEST IF PARAM IS MORE THAN 2CH  10540917
         BNE   SJCCER                                                   10540918
         LA    SJTBRG,SJDTAB            SET TABLE REG TO DEVICE TAB     10540919
         LA    SJCTRG,12                                                10540920
SJASG3   CLC   SJBUCK(2),1(SJTBRG)      COMPARE TABLE ENTRY TO DEV TYPE 10540921
         BE    SJASG4                                                   10540922
         LA    SJTBRG,3(SJTBRG)         INCR TO NEXT TABLE ENTRY        10540923
         BCT   SJCTRG,SJASG3            LOOP TILL END OF TABLE          10540924
         B     SJCCER                                                   10540925
SJASG4   MVC   SJPUB+2(1),0(SJTBRG)     STORE CODE IN PUB               10540926
         CLI   0(SJCCRG),C' '           IS THERE A PARAM4               10540927
         BE    SJASG5                                                   10540928
         BALR  SJLKRG,SJFBRG            MOVE PARAM4 TO BUCKET           10540929
         CLC   SJBUCK(2),SJKHEX         TEST IF PAR4 IS X'XX'           10540930
         BNE   SJCCER                                                   10540931
         CLC   SJBUCK+4(2),SJKQB                                        10540932
         BNE   SJCCER                                                   10540933
         MVC   SJBCK1(2),SJBUCK+2       PLACE HEX CHARS IN BUCKET       10540934
         BAL   SJLKRG,SJCVHB            CONVERT HEX TO BINARY           10540935
         STC   SJW2RG,SJPUB+3           STORE ANS.IN TEMP PUB           10540936
SJASG5   MVC   0(4,SJW4RG),SJPUB        MOVE NEW ASSIGNMENT TO PUB      10540937
         B     SJREAD                                                   10540938
SJCVHB   LA    SJW1RG,SJBCK1+1          POINT REG TO 2ND HEX CHAR       10540939
         LA    SJCTRG,2                 SET COUNTER TO 2                10540940
SJCHBA   SR    SJW2RG,SJW2RG            ZERO WORK REGISTER              10540941
         IC    SJW2RG,0(SJW1RG)         PUT HEX CHAR IN WORK REG        10540942
         TM    0(SJW1RG),X'F0'          IS IT 1111XXXX                  10540943
         BC    14,SJCHB1                BRANCH IF NOT 1111XXXX          10540944
         B     SJCHB2                                                   10540945
SJCHB1   LA    SJW2RG,09(SJW2RG)                                        10540946
         CLI   0(SJW1RG),C'F'                                           10540947
         BH    SJCCER                                                   10540948
         CLI   0(SJW1RG),C'A'                                           10540949
         BL    SJCCER                                                   10540950
SJCHB2   SRDL  SJW2RG,4                 SHIFT GOOD BITS TO ADJACENT REG 10540951
         BCTR  SJW1RG,0                 POINT REG TO 1ST HEX CHAR       10540952
         BCT   SJCTRG,SJCHBA            LOOP ONCE                       10540953
         SLDL  SJW2RG,8            SHIFT BINARY BYTE TO REG FOR STC     10540954
         BR    SJLKRG                                                   10540955
SJNOJC   MVC   SJMESG+3(3),SJNJCM       MOVE MESSAGE FOR NO JOB CARD    10540956
         B     SJMESG                                                   10540957
SJNOSL   MVC   SJMESG+3(3),SJMSG3                                       10540958
         B     SJNOCC+6                                                 10540959
SJNOCC   TM    SJCRJB(SJCRRG),X'02'                                     10540960
         BZ    SJREAD                                                   10540961
         MVC   SJMESG+3(3),SJMSG2                                       10540962
         B     SJMESG                                                   10540963
SJCCER   MVI   SJMESG+3,C'3'            CONTROL CARD ERROR              10540964
         STH   0,SJMESG+4                                               10540965
         OC    SJMESG+4(2),SJK5F0                                       10540966
SJMESG   SVC   2                        TELL SUPV TO DISPLAY MESSAGE    10540967
         DC    C'1   '                  MESSAGE TO BE DISPLAYED         10540968
         DC    C'A'                    RESPONSE REQUESTED               10540969
         DC    C' '                     RESPONSE CHARACTER-NOT USED     10540970
         B     SJREAD        READ NEXT CARD                             10540971
SJLOG    TM    SJCRJB(SJCRRG),X'80'          TEST LOG FLAG              10540972
         BC    1,SJREAD                      IF ON EXIT                 10540973
         OI    SJCRJB(SJCRRG),X'80'          SET LOG FLAG ON            10540974
         BAL   SJLKRG,SJDISP                                            10540975
         B     SJREAD                                                   10540976
SJNLOG   NI    SJCRJB(SJCRRG),X'7F'          RESET LOG FLAG             10540977
         B     SJREAD                                                   10540978
SJDISP   TM    SJCRJB(SJCRRG),X'80'          TEST LOG SW                10540979
         BCR   14,SJLKRG                     EXIT IF OFF                10540980
*   SCAN CARD FROM COL 80 FOR NON-BLANK ,COMPUTE LENGTH FOR CCW         10540981
         LA    SJCCRG,SJINPT+79        COMPUTE LENGTH FOR DISPLAYING    10540982
SJDSP1   CLI   0(SJCCRG),C' '                                           10540983
         BNE   SJDSP2                                                   10540984
         BCT   SJCCRG,SJDSP1                                            10540985
SJDSP2   SH    SJCCRG,SJAIPT                                            10540986
         STH   SJCCRG,SJDCCW+6                                          10540987
         SVC   0                                                        10540988
         DC    YL2(SJDCCB)                                              10540989
         TM    SJDCCB+2,X'80'                                           10540990
         BC    8,*-4                                                    10540991
         BR    SJLKRG                                                   10540992
SJAIPT   DC    YL2(SJINPT-1)                                            10540993
SJFILE   BALR  SJLKRG,SJSBRG                                            10540994
         BAL   SJBRRG,SJSYSR                                            10540995
         STC   SJW1RG,SJTCCB+5               STORE PUB DISP IN CCB      10540996
         CLI   2(SJW2RG),X'00'               TEST FOR TAPE ASSGN IN PUB 10540997
         BNE   SJCCER                                                   10540998
         BALR  SJLKRG,SJFBRG                 GET 2ND PARAMETER          10540999
         CLC   SJBUCK(2),SJKHEX              TEST FORMAT- MUST BE X'HH' 10541000
         BNE   SJCCER                                                   10541001
         CLC   SJBUCK+4(2),SJKQB                                        10541002
         BNE   SJCCER                                                   10541003
         MVC   SJBCK1(2),SJBUCK+2            INIT FOR CONVERSION ROUT   10541004
         BAL   SJLKRG,SJCVHB                 CONVERT HEX TO BINARY      10541005
* RESULT IS IN SJW2RG.THIS WILL BE THE COUNT REG IN SKIP TAPE ROUTINE   10541006
SJSKTP   SVC   0                             SKIP TAPE TO A TAPE MARK   10541007
         DC    YL2(SJTCCB)                                              10541008
         TM    SJTCCB+2,X'80'                                           10541009
         BC    8,*-4                                                    10541010
         BCT   SJW1RG,SJSKTP                 LOOP TILL COUNT OF ZERO    10541011
         B     SJREAD                        EXIT                       10541012
SJREST   BALR  SJLKRG,SJSBRG                                            10541013
         BALR  SJLKRG,SJFBRG                 GET FIRST PARAM            10541014
         BAL   SJBRRG,SJSYSR+2               CONV SYSXXX TO A DISP      10541015
SJRS1    STH   SJW4RG,12(SJCRRG)             STORE DISP IN 2 USER BYTES 10541016
         BALR  SJLKRG,SJFBRG                 GET CHECKPOINT IDENTIFIER  10541017
         CLI   SJBUCK+4,C' '                                            10541018
         BNE   SJCCER                                                   10541019
         MVC  14(4,SJCRRG),SJBUCK            STORE IDEN IN USER BYTES   10541020
         OI    SJCRJB(SJCRRG),X'08'          SET RESTART FLAG ON        10541021
         B     SJREAD                                                   10541022
SJECCB   DC    X'002080000014'          EOJ CCB                         10541023
         DC    YL2(SJECCW)                                              10541024
SJECCW   CCW   9,SJEOJM,X'20',12                                        10541025
SJTCCB   DC    X'000010000018'         TAPE CCB                         10541026
         DC    YL2(SJTCCW)                                              10541027
SJTCCW   CCW   X'3F',SJINPT,X'20',1                                     10541028
SJDCCB   DC    X'001180000014'                                          10541029
         DC    YL2(SJDCCW)                                              10541030
SJDCCW   CCW   9,SJINPT,X'20',80                                        10541031
SJCCB    DC    X'000080000004'                                          10541032
         DC    YL2(SJCCW)                                               10541033
SJCCW    CCW   2,SJINPT,X'20',80                                        10541034
SJBCK1   DS    1CL8                                                     10541035
         DS    1CL80                                                    10541036
SJINPT   DS    1CL80                                                    10541037
SJEOB    DC    YL2(SJBUCK+9)            END OF BUCKET ADDRESS           10541038
SJEOC    DC    YL2(SJINPT+70)           END OF CARD ADDRESS             10541039
SJKW3    DC    X'00000003'                                              10541040
SJK008   DC    X'0008'                                                  10541041
SJK01    DC    X'0001'                                                  10541042
SJBUCK   DS    1CL9                                                     10541043
SJKCTL   DC    C'// '                                                   10541044
SJKPAU   DC    C'PAUSE'                                                 10541045
SJKJOB   DC    C'JOB '                                                  10541046
SJDAT    DC    C' '                                                     10541047
SJKSYS   DC    C'SYS'                                                   10541048
SJKRDR   DC    C'RDR'                                                   10541049
SJKLST   DC    C'LST'                                                   10541050
SJKIPT   DC    C'IPT'                                                   10541051
SJKOPT   DC    C'OPT'                                                   10541052
SJKLOG   DC    C'LOG '                                                  10541053
SJKNLG   DC    C'NOLOG'                                                 10541054
SJPUB    DC    C'    '                  TEMP PUB ENTRY                  10541055
SJ9BLK   DC    C'         '            9 BLANKS                         10541056
SJNJCM   DC    C'0'                     MISSING CONTROL CARD MESSAGE    10541057
         DC    C'40'                       FOR NO JOB CARD              10541058
SJNDCM   DC    C'0'                     MISSING CONTROL CARD MESSAGE    10541059
         DC    C'50'                       FOR NO DATE CARD             10541060
SJMSG1   DC    C'110'                   MESSAGE FOR DUP JOB CARDS       10541061
SJMSG2   DC    C'220'                   CONTROL CARD ERROR MESS175      10541062
SJMSG3   DC    C'200'                  ERROR MESSAGE FOR NO //          10541063
SJPMSG   DC    C'703A '                      PAUSE MESSAGE              10541064
SJDTAB   DC    X'02'                    DEVICE TABLE ENTRIES            10541065
         DC    C'C1'                                                    10541066
         DC    X'06'                                                    10541067
         DC    C'L1'                                                    10541068
         DC    X'12'                                                    10541069
         DC    C'L2'                                                    10541070
         DC    X'0A'                                                    10541071
         DC    C'P1'                                                    10541072
         DC    X'04'                                                    10541073
         DC    C'P2'                                                    10541074
         DC    X'10'                                                    10541075
         DC    C'R0'                                                    10541076
         DC    X'08'                                                    10541077
         DC    C'R1'                                                    10541078
         DC    X'0A'                                                    10541079
         DC    C'R2'                                                    10541080
         DC    X'04'                                                    10541081
         DC    C'R3'                                                    10541082
         DC    X'0E'                                                    10541083
         DC    C'S1'                                                    10541084
         DC    X'00'                                                    10541085
         DC    C'T1'                                                    10541086
         DC    X'00'                                                    10541087
         DC    C'T2'                                                    10541088
SJMOTB   DC    X'1F'                    DAYS IN MONTH TABLE             10541089
SJFEB    DC    X'1C'                                                    10541090
         DC    X'1F'                                                    10541091
         DC    X'1E'                                                    10541092
         DC    X'1F'                                                    10541093
         DC    X'1E'                                                    10541094
         DC    X'1F'                                                    10541095
         DC    X'1F'                                                    10541096
         DC    X'1E'                                                    10541097
         DC    X'1F'                                                    10541098
         DC    X'1E'                                                    10541099
         DC    X'1F'                                                    10541100
SJTABL   DC    YL2(SJDATE)              CONTROL CARD TABLE              10541101
SJKDAT   DC    C'DATE '                                                 10541102
         DC    YL2(SJCONF)                                              10541103
         DC    C'CONFG'                                                 10541104
         DC    YL2(SJVOL)                                               10541105
         DC    C'VOL  '                                                 10541106
         DC    YL2(SJFILE)                                              10541107
         DC    C'FILES'                                                 10541108
         DC    YL2(SJREST)                                              10541109
         DC    C'RSTRT'                                                 10541110
         DC    YL2(SJEXEC)                                              10541111
         DC    C'EXEC '                                                 10541112
         DC    YL2(SJUPSI)                                              10541113
         DC    C'UPSI '                                                 10541114
         DC    YL2(SJASGN)                                              10541115
SJKASG   DC    C'ASSGN'                                                 10541116
SJNUMT   DC    10X'00'                                                  10541117
         DC    C'123456'                                                10541118
SJK5F0   DC    X'F0F0F0F0F0'                                            10541119
SJK50F   DC    X'0F0F0F0F0F'                                            10541120
SJK12    DC    X'F1F2'                                                  10541121
SJKUA    DC    C'UA '                                                   10541122
SJKHEX   DC    CL2'X'''                 CONSTANT X'                     10541123
SJKQB    DC    CL2''' '                 CONSTANT QUOTE-BLANK            10541124
SJKRPG   DC    C'RPG100'                                                10541125
SJKASM   DC    C'ASSEMB'                                                10541126
SJKRES   DC    C'SYSRES'                                                10541127
SJEOJM   DC    C'N EOJ 123456'                                          10541128
*                                                                       10541129
* VOL CARD PROCESSING                                                   10541130
*                                                                       10541131
SJVOL    BALR  SJLKRG,SJSBRG    SKIP BLANKS                             10541132
         BAL   SJW3RG,SJSYSC            CONVERT AND TEST SYSXXX         10541133
         BALR  SJLKRG,SJFBRG            PUT FILE NAME IN BUCKET         10541134
         CLC   SJBUCK(7),SJ9BLK        TEST BLANK FILD                  10541135
         BE    SJLER1                                                   10541136
         MVC   SJLAB(7),SJBUCK         STORE FILE NAME IN LABEL W/A     10541137
         OI    SJNOBR+1,X'F0'                                           10541138
         B     SJREAD                                                   10541139
*       TPLAB CARD INITIAL PROCESSING                                   10541140
SJVOL1   MVI   SJLAB+7,X'00'                                            10541141
         MVC   SJLAB+8(75),SJLAB+7                                      10541142
         LA    SJW3RG,SJLAB+7                                           10541143
         OI    SJLAB3+1,X'F0'                                           10541144
         CLC   SJBUCK(5),SJTLAB         TEST FOR TPLAB CD               10541145
         BC    7,SJNOLC                 BRANCH NOT EQUAL                10541146
*                                                                       10541147
* TPLAB CARD PROCESSING                                                 10541148
*                                                                       10541149
SJTLBP   NI    SJNOBR+1,X'0F'      RESRT SJNOBR SWITCH                  10541150
         BAL   SJBRRG,SJSTRG      PROCESS STRING                        10541151
         B     SJTINU                   BRANCH POINTER FOR CONTINU CARD 10541152
         BC    8,SJLNCK                 TEST FOR 0 LENGTH STRING        10541153
SJGOMO   EX    SJW2RG,SJMOV             MOVE LABEL INFOR                10541154
* CHECK -- STRING AT LEAST 49 BYTES                                     10541155
         LA    SJW3RG,0(SJW2RG,SJW3RG)  FIND LENGTH OF STRING           10541156
SJLNCK   CH    SJW3RG,SJTMIN            TEST LENGTH OF STRING           10541157
         BC    4,SJLCER                 BRANCH NEGATINE                 10541158
         BAL   SJBRRG,SJOTD             OUTPUT LABEL REC TO DISK        10541159
         B     SJREAD                   READ NEXT CARD                  10541160
*                                                                       10541161
SJMOV    MVC   0(1,SJW3RG),0(SJW4RG)    MOVE LABEL INFOR TO OUTPUT AREA 10541162
*                                                                       10541163
SJTINU   EX    SJW2RG,SJMOV                                             10541164
         LA    SJW3RG,1(SJW2RG,SJW3RG)  INCR LABEL OUTPUT AREA FILL ADR 10541165
         BAL   SJBRRG,SJRDCN            READ CONTINUATION CARD          10541166
         BAL   SJBRRG,SJSGAG            CONTINU STRING PROCESSING       10541167
         B     SJLCER                   2ND CONTINU IS ERROR            10541168
         BC    8,SJLNCK                 TEST FOR 0 LENGTH STRING        10541169
         LA    SJBRRG,1(SJW2RG,SJW3RG)  FORM HI LAB ADDR REQUIRED       10541170
         CH    SJBRRG,SJLBHI            TEST FOR ERRONEOUSLY LONG LABEL 10541171
         BC    4,SJGOMO                 BRANCH LABEL                    10541172
         B     SJLCER                   BRANCH TO ERROR                 10541173
         USING SJLAB2,SJW3RG                                            10541174
SJOTD    LH    SJW3RG,SJLCTR+2                                          10541175
         MVC   SJLAB2(83),SJLAB                                         10541176
         LA    SJW3RG,83(SJW3RG)                                        10541177
         STH   SJW3RG,SJLCTR+2                                          10541178
         DROP  SJW3RG                                                   10541179
         BR    SJBRRG                                                   10541180
SJLCTR   DC    H'0'                                                     10541181
         DC    YL2(SJLAB2)                                              10541182
SJLBKT   DC    X'E000'                                                  10541183
SJKON8   DC    H'8192'                                                  10541184
* STRING PROCESSING ROUTINE                                             10541185
*                                                                       10541186
SJSTRG   OI    SJ2QSW+1,X'F0'           MAKE SURE SWITCH RESET          10541187
         BALR  SJLKRG,SJSBRG            SKIP BLANKS                     10541188
         MVC   SJBUCK(9),SJ9BLK         BLANK SJBUCK                    10541189
         AH    0,SJK01                                                  10541190
         CLI   1(SJCCRG),X'7D'          TEST FOR ' AT START             10541191
         BC    7,SJLCER                 BRANCH NO '                     10541192
         LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10541193
         LA    SJW4RG,1(SJCCRG)         SAVE START ADDR                 10541194
SJGOON   LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10541195
         CH    SJCCRG,SJEOC             TEST FOR END OF CARD            10541196
         BC    10,SJEOCF                BRANCH NOT NEG                  10541197
         CLI   0(SJCCRG),X'7D'          TEST FOR '                      10541198
         BC    7,SJGOON                 BRANCH NOT EQUAL                10541199
SJQUOT   CLI   1(SJCCRG),X'7D'          TEST FOR 2ND '                  10541200
         BC    7,SJDID                  BRANCH NOT EQUAL                10541201
         LR    SJW2RG,SJCCRG            MOVE CARD COL INDEX             10541202
SJMVUP   BCTR  SJW2RG,0                 DECR TEMPORARY INDEX            10541203
         MVC   1(1,SJW2RG),0(SJW2RG)    MOVE 1 CHAR UP                  10541204
         CLR   SJW4RG,SJW2RG            TEST FOR LAST CHAR              10541205
         BC    10,SJMVUP                BRANCH NOT NEG                  10541206
         LA    SJW4RG,1(SJW4RG)         INCR BEGIN ADDR                 10541207
         LA    SJCCRG,2(SJCCRG)         INCR CARD COL INDEX             10541208
         B     SJGOON                   CONTINUE SCAN                   10541209
*                                                                       10541210
SJDID    LA    SJBRRG,4(SJBRRG)         INCR RETURN PAST USER EOC BRNCH 10541211
SJNDID   LR    SJW2RG,SJCCRG            FIND LENGTH-1 OF STRING         10541212
         LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10541213
         SR    SJW2RG,SJW4RG                                            10541214
         BCR   13,SJBRRG                RETURN IF LENGTH LENGTH 0       10541215
         BCTR  SJW2RG,0                                                 10541216
         BR    SJBRRG                   RETURN                          10541217
* CONTINUE SCAN ON CONTINUATION CARD                                    10541218
SJSGAG   LA    SJW4RG,1(SJCCRG)         SAVE STRING RESTART ADDR        10541219
SJ2QSW   BC    15,SJGOON                SWITCH TO NORMAL CONTINUATION   10541220
         OI    SJ2QSW+1,X'F0'           RESET SWITCH                    10541221
         B     SJQUOT                   GO TO 2ND QUOT TEST             10541222
*                                                                       10541223
SJEOCF   CLI   0(SJCCRG),X'7D'          END OF CARD OPERATIONS          10541224
         BC    7,SJNAPS                                                 10541225
         CLI   1(SJCCRG),C' '                                           10541226
         BC    8,SJDID                                                  10541227
         NI    SJ2QSW+1,X'0F'                                           10541228
         B     SJNDID                                                   10541229
*                                                                       10541230
SJNAPS   CLI   1(SJCCRG),C' '           TEST FOR CONTINUE               10541231
         BC    8,SJLCER                 BRANCH EQUAL                    10541232
SJNDEC   LR    SJW2RG,SJCCRG            FIND LENGTH-1 SO FAR            10541233
         SR    SJW2RG,SJW4RG                                            10541234
         BR    SJBRRG                                                   10541235
*                                                                       10541236
*                                                                       10541237
* READ CONTINUE CARD AND CHECK 1ST 15 COLS ARE BANK                     10541238
*                                                                       10541239
SJRDCN   BAL   SJLKRG,SJRDCD            READ CARD                       10541240
         CLI   SJINPT,C' '              TEST 1ST 15 COLS BLANK          10541241
         BNE   SJLCER                                                   10541242
         CLC   SJINPT+1(14),SJINPT                                      10541243
         BNE   SJLCER                                                   10541244
         LA    SJCCRG,SJINPT+14         LOAD CONTINUE SCAN ADDR         10541245
         BR    SJBRRG                   RETURN                          10541246
*                                                                       10541247
* SUBROUTINE -- RESET BRANCH SWITCHES                                   10541248
*                                                                       10541249
SJRRST   NI    SJNOBR+1,X'0F'        RESET NOBR SWITCHES                10541250
         BR    SJLKRG                                                   10541251
*                                                                       10541252
* NO LABEL CARD ROUTINE                                                 10541253
SJNOLC   BAL   SJLKRG,SJRRST                                            10541254
SJNLC1   NC    SJCRJB(2,SJCRRG),SJCRRS  RESET JOB CONTROL SWITCHES      10541255
         B     SJNOCC+8                 BRANCH TO NO CONTROL CARD       10541256
*ROUTINE FOR ERROR IN LABEL CARD                                        10541257
SJLCER   BAL   SJLKRG,SJRRST                                            10541258
SJLER1   NC    SJCRJB(2,SJCRRG),SJCRRS                                  10541259
         B     SJCCER                                                   10541260
* SUBROUTINE FOR SYSXXX CHECK AND CONVERSION                            10541261
SJSYSC   NI    SJNOBR+1,X'0F'   RESET SWITCHES                          10541262
         MVC   SJSAVS(2),SJCRJB(SJCRRG) SAVE JOB CONTROL BYTES          10541263
         NC    SJCRJB(2,SJCRRG),SJCRRS  RESET JOB CONTROL BYTES         10541264
         BALR  SJLKRG,SJSBRG   SKIP BLANKS                              10541265
         BAL   SJBRRG,SJSYSR   CONVERT AND CHECK                        10541266
         OI    SJNOBR+1,X'F0'     RESTORE SWITCHES                      10541267
         MVC   SJCRJB(2,SJCRRG),SJSAVS  RESTORE JOB CONTROL BYTES       10541268
         BR    SJW3RG    RETURN                                         10541269
SJMLAB   SR    SJW2RG,SJW2RG                                            10541270
         LA    SJW1RG,SJLAB2    GET WORK AREA ADD                       10541271
         LH    SJW4RG,SJLCTR+2                                          10541272
         SR    SJW4RG,SJW1RG                                            10541273
         SR    SJW3RG,SJW4RG   GET START ADD                            10541274
         MVI   0(SJW3RG),C'*'  PUT * IN FIRST POS VOL AREA              10541275
         LA    SJW3RG,1(SJW3RG)                                         10541276
SJLAB4   MVC   0(83,SJW3RG),0(SJW1RG)                                   10541277
         LA    SJW2RG,83(SJW2RG)                                        10541278
         LA    SJW1RG,83(SJW1RG)                                        10541279
         CR    SJW2RG,SJW4RG                                            10541280
         BE    SJEXQ6                                                   10541281
         LA    SJW3RG,83(SJW3RG)                                        10541282
         B     SJLAB4                                                   10541283
*  STORAGE AND CONSTANTS                                                10541284
SJLAB    DS    CL85                                                     10541285
SJTLAB   DC    CL5'TPLAB'                                               10541286
SJDECM   EQU   SJBCK1                                                   10541287
SJSAVS   DS    CL2                                                      10541288
SJTMIN   DC    YL2(SJLAB+55)                                            10541289
SJLBHI   DC    YL2(SJLAB+83)                                            10541290
SJCRRS   DC    X'8001'                                                  10541291
SJLAB2   DS    CL85                                                     10541292
         END   START                                                    10541293
         TITLE 'PHASE 1   TAPE TO TAPE'                                 10541294
         START 2488                                                     10541295
STRT     BALR  15,0                                                     10541296
         USING *,15                                                     10541297
         BC    15,INPUT                                                 10541298
         ORG   *+6                                                      10541299
SORS     DC    F'1'           STARTING RECORD NUMBER                    10541300
QORS     DC    F'0'           SEQUENCING INFORMATION                    10541301
IRCLN    DC    H'1000'        INPUT RECORD LENGTH                       10541302
IBKSZ    DC    H'1000'        INPUT BLOCK SIZE                          10541303
ORCLN    DC    H'1000'        OUTPUT RECORD LENGTH                      10541304
OBKSZ    DC    H'1000'        OUTPUT BLOCK SIZE                         10541305
TPGM     DC    X'22'          PROGRAM TYPE                              10541306
TJOB     DC    X'01'          TYPE OF JOB                               10541307
FRCD     DC    X'04'          RECORD FORMAT                             10541308
DOPTN    DC    X'88'          INPUT AND OUTPUT OPTIONS                  10541309
POPTN    DC    X'00'                                                    10541310
LABSW    DC    X'00'                                                    10541311
ICU      DC    X'00'                                                    10541312
OCU      DC    X'00'                                                    10541313
IBKC     DC    F'0'                                                     10541314
OBKC     DC    F'0'                                                     10541315
LABIH    DC    C'**'                                                    10541316
LABOH    DC    C'**'                                                    10541317
LABIT    DC    X'18E8'        INITIALIZED TO INPUT HEADER END           10541318
LABOT    DC    X'16F0'        INITIALIZED TO OUTPUT TRAILER END         10541319
LABOR    DC    X'18E8'        INITIALIZED TO PHASE 3 END                10541320
AAST     DC    H'0'                                                     10541321
LABRTN   DC    X'128E'        INITIALIZED TO PHASE 4 END                10541322
IPA      DC    X'0C0C'                                                  10541323
OPA      DC    X'1010'                                                  10541324
INA      DC    X'16F0'        INITIALIZED TO INPUT TRAILER END          10541325
INB      DC    H'0'                                                     10541326
OUTA     DC    H'0'                                                     10541327
OUTB     DC    H'0'                                                     10541328
UCLIM    DC    H'0'                                                     10541329
SWHD     DC    X'00'                                                    10541330
NOIO     DC    X'00'                                                    10541331
HEAD     DC    CL16'                '                                   10541332
         DC    CL16'                '                                   10541333
         DC    CL16'                '                                   10541334
         DC    CL16'                '                                   10541335
         DC    CL16'                '                                   10541336
         DC    CL16'                '                                   10541337
         DC    CL16'                '                                   10541338
         DC    CL16'                '                                   10541339
         DC    CL16'                '                                   10541340
DSTBL    DC    C'0123456789ABCDEF'                                      10541341
ULAB1    DC    H'0'                                                     10541342
ULAB2    DC    H'0'                                                     10541343
ULAB3    DC    H'0'                                                     10541344
ULAB4    DC    H'0'                                                     10541345
URET     DC    H'0'                                                     10541346
ULAB     DC    H'0'                                                     10541347
USW      DC    X'F0'                                                    10541348
         ORG   SORS+250                                                 10541349
*                                                                       10541350
***   CONTROL CARD INPUT                                                10541351
*                                                                       10541352
INPUT    SVC   0                                                        10541353
         DC    YL2(CCB)                                                 10541354
         TM    CCB+2,X'80'                                              10541355
         BC    8,*-4                                                    10541356
         CLC   HD1(3),CRDAR   IS CONTROL CARD                           10541357
         BC    7,LG1          NO                                        10541358
         CLI   CRDAR+3,C'U'   IS UTILITY MODIFIER CARD                  10541359
         BC    8,UTMF         YES                                       10541360
         CLC   HD2(3),CRDAR+3 IS FIELD SELECT CARD                      10541361
         BC    8,FS           YES                                       10541362
         TM    FSW,X'0F'      IS FIELD SELECT ENFORCED                  10541363
         BC    7,LG3          YES, LOG MESSAGE                          10541364
         CLC   HD3(3),CRDAR+3 IS HEADER CARD NO.1                       10541365
         BC    7,*+12         NO                                        10541366
         OI    SWHD,X'FF'     YES, SET SWHD                             10541367
         BC    15,HD                                                    10541368
         CLC   HD4(3),CRDAR+3 IS HEADER CARD NO.2                       10541369
         BC    7,*+12         NO                                        10541370
         OI    SWHD,X'FF'     YES, SET SWHD                             10541371
         BC    15,HDSD                                                  10541372
         CLC   HD5(3),CRDAR+3 IS END CARD                               10541373
         BC    7,LG6                                                    10541374
LGSW     BC    0,EOJ                                                    10541375
         SVC   1                                                        10541376
         DC    C'SYSLOD'                                                10541377
*                                                                       10541378
***   CONVERSION ROUTINE                                                10541379
*                                                                       10541380
BIN      MVC   BINC+1(1),0(6) SUPPLY ENDING CHARACTER                   10541381
         MVC   CBNN+1(1),0(6)                                           10541382
         LR    3,2            CHECK 4 DIGITS                            10541383
         LA    4,1                                                      10541384
         LA    5,3(2)                                                   10541385
         MVI   *-1,X'03'                                                10541386
LOOP     CLI   0(3),X'F0'                                               10541387
         BCR   4,8                                                      10541388
         CLI   0(3),X'F9'                                               10541389
         BCR   2,8                                                      10541390
         BXH   3,4,CBNN                                                 10541391
BINC     CLI   0(3),C','                                                10541392
         BC    8,*+14                                                   10541393
         BC    15,LOOP                                                  10541394
CBNN     CLI   0(3),C','                                                10541395
         BCR   7,8                                                      10541396
         LR    4,2                                                      10541397
         LA    2,1(3)                                                   10541398
         SR    3,4                                                      10541399
         BCTR  3,0                                                      10541400
         AH    3,N112                                                   10541401
         STC   3,*+5                                                    10541402
         PACK  TEMP(8),0(0,4) CONVERT TO BINARY                         10541403
         CVB   3,TEMP                                                   10541404
         C     3,N64K                                                   10541405
         BC    2,*+12                                                   10541406
         STH   3,0(9)                                                   10541407
         BC    15,2(6)                                                  10541408
         BCTR  2,0                                                      10541409
         BCR   15,8                                                     10541410
*                                                                       10541411
***   ERROR LOGGING ROUTINE                                             10541412
*                                                                       10541413
LG1      LA    5,MSSG1                                                  10541414
         LA    6,15                                                     10541415
         STC   6,LGMVC+1                                                10541416
         BC    15,LG                                                    10541417
LG2      LA    5,MSSG2                                                  10541418
         LA    6,38                                                     10541419
         STC   6,LGMVC+1                                                10541420
         OI    NTSW+1,X'F0'                                             10541421
         BC    15,LG                                                    10541422
LG3      LA    5,MSSG3                                                  10541423
         LA    6,24                                                     10541424
         STC   6,LGMVC+1                                                10541425
         BC    15,LG                                                    10541426
LG4      LA    5,MSSG4                                                  10541427
         LA    6,36                                                     10541428
         STC   6,LGMVC+1                                                10541429
         OI    NTSW+1,X'F0'                                             10541430
         LH    3,NOFS                                                   10541431
         AH    3,N1                                                     10541432
         STH   3,NOFS                                                   10541433
         BC    15,LG                                                    10541434
LG5      LA    5,MSSG5                                                  10541435
         LA    6,29                                                     10541436
         STC   6,LGMVC+1                                                10541437
         BC    15,LG                                                    10541438
LG6      LA    5,MSSG6                                                  10541439
         LA    6,19                                                     10541440
         STC   6,LGMVC+1                                                10541441
LG       XC    LOGAR(39),LOGAR    CLEAR PRINT AREA                      10541442
         LA    6,1(6)                                                   10541443
         STC   6,CCWL+7                                                 10541444
LGMVC    MVC   LOGAR(0),0(5)  MOVE MESSAGE TO PRINT AREA                10541445
         SVC   0             PRINT MSSG                                 10541446
         DC    YL2(CCBL)                                                10541447
         TM    CCBL+2,X'80'                                             10541448
         BC    8,*-4                                                    10541449
         OI    LGSW+1,X'F0'                                             10541450
NTSW     BC    0,NTRTN                                                  10541451
EOJ      SVC   1                                                        10541452
         DC    C'SYSEOJ'                                                10541453
NTRTN    NI    NTSW+1,X'00'                                             10541454
CKSW     BC    0,TPJOB                                                  10541455
CKSW1    BC    0,TPJBS                                                  10541456
         CLI   FSW,X'F0'                                                10541457
         BC    8,FSCK                                                   10541458
RET      LA    2,1(2)                                                   10541459
         CLI   0(2),C','                                                10541460
         BC    7,*+12                                                   10541461
         LA    2,1(2)                                                   10541462
         BC    15,SFSC+12                                               10541463
         CLI   0(2),C' '                                                10541464
         BC    7,RET                                                    10541465
         BC    15,SFS+8                                                 10541466
FSCK     LA    2,1(2)                                                   10541467
         CLI   0(2),C'/'                                                10541468
         BC    7,*+12                                                   10541469
         LA    2,1(2)                                                   10541470
         BC    15,FSIN                                                  10541471
         CLI   0(2),C' '                                                10541472
         BC    7,FSCK                                                   10541473
         BC    15,INPUT                                                 10541474
*                                                                       10541475
***   FINDING TYPE OF PROGRAM                                           10541476
*                                                                       10541477
UTMF     LA    2,CRDAR+4                                                10541478
         CLI   0(2),C' '      IS NEXT BLANK                             10541479
         BC    8,TPJBS        YES, BRANCH TO TPJBS                      10541480
         MVI   MSSG2,C'N'                                               10541481
         OI    CKSW+1,X'F0'                                             10541482
         CLI   0(2),C'C'      IS CARD INPUT                             10541483
         BC    7,*+12         NO, BRANCH TO NEXT                        10541484
         MVI   TPGM,X'10'     YES, SET TPGM                             10541485
         BC    15,OUTD                                                  10541486
         CLI   0(2),C'T'      IS TAPE INPUT                             10541487
         BC    7,*+12         NO, BRANCH TO NEXT                        10541488
         MVI   TPGM,X'20'     YES, SET TPGM                             10541489
         BC    15,OUTD                                                  10541490
         CLI   0(2),C'D'      IS DISK INPUT                             10541491
         BC    7,LG2          NO, ILLEGAL CHARACTER                     10541492
         MVI   TPGM,X'40'     YES, SET TPGM                             10541493
OUTD     CLI   1(2),C'C'      IS CARD OUTPUT                            10541494
         BC    7,*+12         NO, BRANCH TO NEXT                        10541495
         OI    TPGM,X'01'     YES, SET TPGM                             10541496
         BC    15,TPJOB                                                 10541497
         CLI   1(2),C'T'      IS TAPE OUTPUT                            10541498
         BC    7,*+12         NO, BRANCH TO NEXT                        10541499
         OI    TPGM,X'02'     YES, SET TPGM                             10541500
         BC    15,TPJOB                                                 10541501
         CLI   1(2),C'D'      IS DISK OUTPUT                            10541502
         BC    7,*+12         NO, BRANCH TO NEXT                        10541503
         OI    TPGM,X'04'     YES, SET TPGM                             10541504
         BC    15,TPJOB                                                 10541505
         CLI   1(2),C'P'      IS PRINT OUTPUT                           10541506
         BC    7,LG2          NO, ILLEGAL CHARACTER                     10541507
         OI    TPGM,X'08'     YES, SET TPGM                             10541508
*                                                                       10541509
***   FINDING TYPE OF JOB                                               10541510
*                                                                       10541511
TPJOB    NI    CKSW+1,X'00'                                             10541512
         OI    CKSW1+1,X'F0'                                            10541513
         LA    2,2(2)                                                   10541514
         CLI   0(2),C' '      IS NEXT BLANK                             10541515
         BC    7,LG2          NO, ILLEGAL FORMAT                        10541516
TPJBS    NI    CKSW1+1,X'00'                                            10541517
         MVI   MSSG2,C'T'                                               10541518
         CLI   1(2),C'T'      IS TYPE DEFINED                           10541519
         BC    7,LG2          NO, ILLEGAL FORMAT                        10541520
         MVI   MSSG2,C'J'                                               10541521
         LA    2,2(2)                                                   10541522
         CLI   0(2),C'C'      IS COPY                                   10541523
         BC    7,*+12         NO, BRANCH TO NEXT                        10541524
         MVI   TJOB,X'01'     YES, SET TJOB                             10541525
         BC    15,SFSC                                                  10541526
         CLI   0(2),C'F'      IS FIELD SELECT                           10541527
         BC    7,*+16         NO, BRANCH TO NEXT                        10541528
         MVI   TJOB,X'02'     YES, SET TJOB                             10541529
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10541530
         BC    15,SFSC                                                  10541531
         CLI   0(2),C'R'      IS REBLOCK                                10541532
         BC    7,EDD          NO, BRANCH TO NEXT                        10541533
         CLI   1(2),C'F'      IS REBLOCK AND FIELD SELECT               10541534
         BC    7,*+20         NO                                        10541535
         MVI   TJOB,X'08'     YES, SET TJOB                             10541536
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10541537
         LA    2,1(2)                                                   10541538
         BC    15,SFSC                                                  10541539
         MVI   TJOB,X'04'     SET TJOB                                  10541540
         BC    15,SFSC                                                  10541541
EDD      CLI   0(2),C'D'      IS DATA DISPLAY                           10541542
         BC    7,*+12         NO, BRANCH TO NEXT                        10541543
         MVI   TJOB,X'10'     YES, SET TJOB                             10541544
         BC    15,SFSC                                                  10541545
         CLI   0(2),C'L'      IS LIST                                   10541546
         BC    7,EB           NO, BRANCH TO EB                          10541547
         CLI   1(2),C'F'      IS LIST AND FIELD SELECT                  10541548
         BC    7,*+20         NO                                        10541549
         MVI   TJOB,X'00'     YES, SET TJOB                             10541550
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10541551
         LA    2,1(2)                                                   10541552
         BC    15,SFSC                                                  10541553
         MVI   TJOB,X'20'     SET TJOB                                  10541554
         BC    15,SFSC                                                  10541555
EB       CLI   0(2),C'B'      IS BOTH                                   10541556
         BC    7,LG2          NO, ILLEGAL FORMAT                        10541557
         CLI   1(2),C'F'      IS BOTH WITH FIELD SELECT                 10541558
         BC    7,*+20         NO                                        10541559
         MVI   TJOB,X'80'     YES, SET TJOB                             10541560
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10541561
         LA    2,1(2)                                                   10541562
         BC    15,SFSC                                                  10541563
         MVI   TJOB,X'40'     SET TJOB                                  10541564
         BC    15,SFSC                                                  10541565
*                                                                       10541566
***   ENTRANCE TO SEARCH OF PARAMETERS                                  10541567
*                                                                       10541568
SFS      CLI   1(2),C' '      IS BLANK                                  10541569
         BC    7,SFSC         NO, BRANCH TO SFSC                        10541570
         BC    0,INPUT                                                  10541571
         OI    *-3,X'F0'                                                10541572
         MVI   MSSG2,C'M'                                               10541573
         CLI   REQPA,X'07'    GOT ALL REQUIRED PARAMETERS               10541574
         BC    7,LG2          NO, ILLEGAL FORMAT                        10541575
         BC    15,INPUT       YES, READ NEXT CARD                       10541576
SFSC     CLI   1(2),C','      IS COMMA                                  10541577
         BC    7,LG2          NO, ILLEGAL FORMAT                        10541578
         LA    2,2(2)                                                   10541579
*                                                                       10541580
***   RECORD FORMAT PARAMETER                                           10541581
*                                                                       10541582
         CLI   0(2),C'F'      IS FORMAT DEFINED                         10541583
         BC    7,INF          NO, BRANCH TO INF                         10541584
         NI    FRCD,X'F0'                                               10541585
         LA    2,1(2)                                                   10541586
         OI    REQPA,X'01'    YES, MODIFY REQPA                         10541587
         MVI   MSSG2,C'F'                                               10541588
         CLI   0(2),C'F'      IS F-PARAMETER                            10541589
         BC    7,*+12         NO, BRANCH TO NEXT                        10541590
         OI    FRCD,X'01'     YES, MODIFY FRCD                          10541591
         BC    15,SFS                                                   10541592
         CLI   0(2),C'V'      IS V-PARAMETER                            10541593
         BC    7,*+12         NO, BRANCH TO NEXT                        10541594
         OI    FRCD,X'02'     YES, MODIFY FRCD                          10541595
         BC    15,SFS                                                   10541596
         CLI   0(2),C'U'      IS U-PARAMETER                            10541597
         BC    7,LG2          NO, ILLEGAL FORMAT                        10541598
         OI    FRCD,X'04'     YES, MODIFY FRCD                          10541599
         BC    15,SFS                                                   10541600
*                                                                       10541601
***   A-PARAMETER                                                       10541602
*                                                                       10541603
INF      CLC   0(3,2),HD6     IS A-PARAMETER                            10541604
         BC    7,OUTF         NO, BRANCH TO OUTF                        10541605
         OI    REQPA,X'02'    YES, MODIFY REQPA                         10541606
         MVI   MSSG2,C'A'                                               10541607
         LA    2,3(2)                                                   10541608
         TM    FRCD,X'01'     IS FIXED                                  10541609
         BC    8,LICB         NO, BRANCH TO LICB                        10541610
         CLC   0(2,2),HD7     IS 'K='                                   10541611
         BC    7,ULFT         NO, BRANCH TO ULFT                        10541612
         OI    FRCD,X'10'     YES, MODIFY FRCD                          10541613
         LA    2,2(2)                                                   10541614
         LA    8,LG2          CONVERT DIGITS TO BINARY                  10541615
         LA    9,IRCLN        AND STORE IN IRCLN                        10541616
         BAL   6,BIN                                                    10541617
         DC    C', '                                                    10541618
         CLC   0(2,2),HD8     IS 'D='                                   10541619
         BC    7,LG2          NO, ILLEGAL FORMAT                        10541620
         LA    2,2(2)                                                   10541621
         BC    15,LICB                                                  10541622
ULFT     LA    8,LG2          CONVERT DIGITS TO BINARY                  10541623
         LA    9,IRCLN        AND STORE IN IRCLN                        10541624
         BAL   6,BIN                                                    10541625
         DC    C', '                                                    10541626
LICB     LA    8,LG2          CONVERT DIGITS TO BINARY                  10541627
         LA    9,IBKSZ        AND STORE IN IBKSZ                        10541628
         MVI   LOOP-5,X'04'                                             10541629
         BAL   6,BIN                                                    10541630
         DC    C') '                                                    10541631
         TM    FRCD,X'01'     IS FIXED                                  10541632
         BC    1,*+10         YES                                       10541633
         MVC   IRCLN(2),IBKSZ NO, DEFINE INPUT RECORD LENGTH            10541634
         BCTR  2,0                                                      10541635
         BC    15,SFS                                                   10541636
*                                                                       10541637
***   B-PARAMETER                                                       10541638
*                                                                       10541639
OUTF     CLC   0(3,2),HD9     IS B-PARAMETER                            10541640
         BC    7,IPAR         NO, BRANCH TO IPAR                        10541641
         OI    REQPA,X'04'    YES, MODIFY REQPA                         10541642
         MVI   MSSG2,C'B'                                               10541643
         LA    2,3(2)                                                   10541644
         TM    FRCD,X'01'     IS FIXED                                  10541645
         BC    8,LOCB         NO, BRANCH TO LOCB                        10541646
         CLC   0(2,2),HD7     IS 'K='                                   10541647
         BC    8,LCHS         YES, BRANCH TO LCHS                       10541648
         LR    3,2                                                      10541649
         LA    4,1                                                      10541650
         LA    5,3(2)                                                   10541651
LOOP1    CLI   0(3),X'F0'                                               10541652
         BC    4,LG2                                                    10541653
         CLI   0(3),X'F9'                                               10541654
         BC    2,LG2                                                    10541655
         BXH   3,4,CBNN1                                                10541656
         CLI   0(3),C','                                                10541657
         BC    8,CNQ1                                                   10541658
         CLI   0(3),C')'                                                10541659
         BC    7,LOOP1                                                  10541660
         OI    LABSW,X'01'                                              10541661
         BC    15,LOCB                                                  10541662
CBNN1    CLI   0(3),C','                                                10541663
         BC    8,CNQ1                                                   10541664
         CLI   0(3),C')'                                                10541665
         BC    7,LG2                                                    10541666
         OI    LABSW,X'01'                                              10541667
         BC    15,LOCB                                                  10541668
CNQ1     LR    5,2                                                      10541669
         LA    2,1(3)                                                   10541670
         BCTR  3,0                                                      10541671
         SR    3,5                                                      10541672
         AH    3,N112                                                   10541673
         STC   3,*+5                                                    10541674
         PACK  TEMP(8),0(0,5)                                           10541675
         CVB   3,TEMP                                                   10541676
         STH   3,ORCLN                                                  10541677
LOCB     LA    8,LG2          CONVERT DIGITS TO BINARY                  10541678
         LA    9,OBKSZ        AND STORE IN OBKSZ                        10541679
         MVI   LOOP-5,X'04'                                             10541680
         BAL   6,BIN                                                    10541681
         DC    C') '                                                    10541682
         BCTR  2,0                                                      10541683
         TM    FRCD,X'01'                                               10541684
         BC    8,*+16                                                   10541685
         TM    LABSW,X'01'                                              10541686
         BC    1,SORL                                                   10541687
         BC    15,SFS                                                   10541688
SORL     MVC   ORCLN(2),OBKSZ YES, DEFINE OUTPUT RECORD LENGTH          10541689
         BC    15,SFS                                                   10541690
LCHS     OI    FRCD,X'20'     MODIFY FRCD                               10541691
         LA    2,2(2)                                                   10541692
         LA    8,LG2          CONVERT DIGITS TO BINARY                  10541693
         LA    9,ORCLN        AND STORE IN ORCLN                        10541694
         BAL   6,BIN                                                    10541695
         DC    C', '                                                    10541696
         CLC   0(2,2),HD8     IS 'D='                                   10541697
         BC    7,LG2          NO, ILLEGAL FORMAT                        10541698
         LA    2,2(2)                                                   10541699
         BC    15,LOCB                                                  10541700
*                                                                       10541701
***   I-PARAMETER                                                       10541702
*                                                                       10541703
IPAR     CLI   0(2),C'I'      IS I-PARAMETER                            10541704
         MVI   MSSG2,C'I'                                               10541705
         BC    7,OPAR         NO, BRANCH TO OPAR                        10541706
         NI    DOPTN,X'0F'                                              10541707
         CLI   1(2),C'1'      IS '1'                                    10541708
         BC    7,*+12         NO, BRANCH TO NEXT                        10541709
         OI    DOPTN,X'00'    YES, SET DOPTN                            10541710
         BC    15,TMIP                                                  10541711
         CLI   1(2),C'2'      IS '2'                                    10541712
         BC    8,*+12         YES                                       10541713
         CLI   1(2),C'M'      IS 'M'                                    10541714
         BC    7,*+12         NO, BRANCH TO NEXT                        10541715
         OI    DOPTN,X'10'    YES, SET DOPTN                            10541716
         BC    15,TMIP                                                  10541717
         CLI   1(2),C'U'      IS 'U'                                    10541718
         BC    7,*+12         NO, BRANCH TO NEXT                        10541719
         OI    DOPTN,X'80'    YES, SET DOPTN                            10541720
         BC    15,TMIP                                                  10541721
         CLI   1(2),C'R'      IS 'R'                                    10541722
         BC    7,*+12         NO, BRANCH TO NEXT                        10541723
         OI    DOPTN,X'40'    YES, SET DOPTN                            10541724
         BC    15,TMIP                                                  10541725
         CLI   1(2),C'N'      IS 'N'                                    10541726
         BC    7,LG2          NO, ILLEGAL FORMAT                        10541727
         OI    DOPTN,X'20'    YES, SET DOPTN                            10541728
TMIP     LA    2,1(2)                                                   10541729
         BC    15,SFS                                                   10541730
*                                                                       10541731
***   O-PARAMETER                                                       10541732
*                                                                       10541733
OPAR     CLI   0(2),C'O'      IS O-PARAMETER                            10541734
         BC    7,SPAR         NO, BRANCH TO SPAR                        10541735
         MVI   MSSG2,C'O'                                               10541736
         NI    DOPTN,X'F0'                                              10541737
         CLI   1(2),C'1'      IS '1'                                    10541738
         BC    7,*+12         NO, BRANCH TO NEXT                        10541739
         OI    DOPTN,X'00'    YES, SET DOPTN                            10541740
         BC    15,TMOP                                                  10541741
         CLI   1(2),C'2'      IS '2'                                    10541742
         BC    8,*+12                                                   10541743
         CLI   1(2),C'Y'      NO, IS 'Y'                                10541744
         BC    7,*+12         NO, BRANCH TO NEXT                        10541745
         OI    DOPTN,X'01'    YES, SET DOPTN                            10541746
         BC    15,TMOP                                                  10541747
         CLI   1(2),C'U'      IS 'U'                                    10541748
         BC    8,*+12                                                   10541749
         CLI   1(2),C'C'      NO, IS 'C'                                10541750
         BC    7,*+12         NO, BRANCH TO NEXT                        10541751
         OI    DOPTN,X'08'    YES, SET DOPTN                            10541752
         BC    15,TMOP                                                  10541753
         CLI   1(2),C'R'      IS 'R'                                    10541754
         BC    8,*+12                                                   10541755
         CLI   1(2),C'X'      NO, IS 'X'                                10541756
         BC    7,*+12         NO, BRANCH TO NEXT                        10541757
         OI    DOPTN,X'04'    YES, SET DOPTN                            10541758
         BC    15,TMOP                                                  10541759
         CLI   1(2),C'N'      IS 'N'                                    10541760
         BC    7,LG2          NO, ILLEGAL FORMAT                        10541761
         OI    DOPTN,X'02'    YES, SET DOPTN                            10541762
TMOP     LA    2,1(2)                                                   10541763
         BC    15,SFS                                                   10541764
*                                                                       10541765
***   S-PARAMETER                                                       10541766
*                                                                       10541767
SPAR     CLI   0(2),C'S'      IS S-PARAMETER                            10541768
         BC    7,PPAR         NO, BRANCH TO PPAR                        10541769
         MVI   MSSG2,C'S'                                               10541770
         NI    POPTN,X'0F'                                              10541771
         CLI   1(2),C'1'      IS '1'                                    10541772
         BC    7,*+12         NO, BRANCH TO NEXT                        10541773
         OI    POPTN,X'10'    YES, SET POPTN                            10541774
         BC    15,TMSP                                                  10541775
         CLI   1(2),C'2'      IS '2'                                    10541776
         BC    7,*+12         NO, BRANCH TO NEXT                        10541777
         OI    POPTN,X'20'    YES, SET POPTN                            10541778
         BC    15,TMSP                                                  10541779
         CLI   1(2),C'3'      IS '3'                                    10541780
         BC    7,LG2          NO, ILLEGAL FORMAT                        10541781
         OI    POPTN,X'40'    YES, SET POPTN                            10541782
TMSP     LA    2,1(2)                                                   10541783
         BC    15,SFS                                                   10541784
*                                                                       10541785
***   P-PARAMETER                                                       10541786
*                                                                       10541787
PPAR     CLI   0(2),C'P'      IS P-PARAMETER                            10541788
         BC    7,RPAR         NO, BRANCH TO RPAR                        10541789
         MVI   MSSG2,C'P'                                               10541790
         NI    POPTN,X'F0'                                              10541791
         CLI   1(2),C'Y'      IS 'Y'                                    10541792
         BC    7,*+12         NO, BRANCH TO NEXT                        10541793
         OI    POPTN,X'01'    YES, SET POPTN                            10541794
         BC    15,TMPP                                                  10541795
         CLI   1(2),C'N'      IS 'N'                                    10541796
         BC    7,LG2          NO, ILLEGAL FORMAT                        10541797
         OI    POPTN,X'02'    YES, SET POPTN                            10541798
TMPP     LA    2,1(2)                                                   10541799
         BC    15,SFS                                                   10541800
*                                                                       10541801
***   R-PARAMETER                                                       10541802
*                                                                       10541803
RPAR     CLI   0(2),C'R'     IS R-PARAMETER                             10541804
         BC    7,QPAR         NO, BRANCH TO QPAR                        10541805
         MVI   MSSG2,C'R'                                               10541806
         LA    2,1(2)         CHECK DIGITS                              10541807
         LR    3,2                                                      10541808
         LA    4,1                                                      10541809
         LA    5,7(2)                                                   10541810
LP1      CLI   0(3),X'F0'                                               10541811
         BC    4,LG2                                                    10541812
         CLI   0(3),X'F9'                                               10541813
         BC    2,LG2                                                    10541814
         BXH   3,4,CBIN1                                                10541815
         CLI   0(3),C','                                                10541816
         BC    8,CBIN1+16                                               10541817
         CLI   0(3),C' '                                                10541818
         BC    7,LP1                                                    10541819
         BC    8,CBIN1+16                                               10541820
CBIN1    CLI   0(3),C','                                                10541821
         BC    8,*+12                                                   10541822
         CLI   0(3),C' '                                                10541823
         BC    7,LG2                                                    10541824
         LR    5,2            CONVERT TO BINARY AND STORE IT TO SORS    10541825
         BCTR  3,0                                                      10541826
         LR    2,3                                                      10541827
         SR    3,5                                                      10541828
         AH    3,N112                                                   10541829
         STC   3,*+5                                                    10541830
         PACK  TEMP(8),0(0,5)                                           10541831
         CVB   3,TEMP                                                   10541832
         ST    3,SORS                                                   10541833
         BC    15,SFS                                                   10541834
*                                                                       10541835
***   Q-PARAMETER                                                       10541836
*                                                                       10541837
QPAR     CLC   0(3,2),HD11    IS Q-PARAMETER                            10541838
         MVI   MSSG2,C'U'                                               10541839
         BC    7,LG2          NO, ILLEGAL FORMAT                        10541840
         MVI   MSSG2,C'Q'                                               10541841
         LA    2,3(2)         CHECK DIGITS                              10541842
         LR    3,2                                                      10541843
         LA    4,1                                                      10541844
         LA    5,1(2)                                                   10541845
LP2      CLI   0(3),X'F0'                                               10541846
         BC    4,LG2                                                    10541847
         CLI   0(3),X'F9'                                               10541848
         BC    2,LG2                                                    10541849
         BXH   3,4,CBIN2                                                10541850
         CLI   0(3),C','                                                10541851
         BC    7,LP2                                                    10541852
         BC    8,*+12                                                   10541853
CBIN2    CLI   0(3),C','                                                10541854
         BC    7,LG2                                                    10541855
         LR    5,2            CONVERT TO BINARY AND STORE IT TO QORS    10541856
         LR    2,3                                                      10541857
         BCTR  3,0                                                      10541858
         SR    3,5                                                      10541859
         AH    3,N112                                                   10541860
         STC   3,*+5                                                    10541861
         PACK  TEMP(8),0(0,5)                                           10541862
         CVB   3,TEMP                                                   10541863
         STH   3,QORS                                                   10541864
         LA    2,1(2)         CHECK DIGITS                              10541865
         LR    3,2                                                      10541866
         LA    4,1                                                      10541867
         LA    5,1(2)                                                   10541868
LP3      CLI   0(3),X'F0'                                               10541869
         BC    4,LG2                                                    10541870
         CLI   0(3),X'F9'                                               10541871
         BC    2,LG2                                                    10541872
         BXH   3,4,CBIN3                                                10541873
         CLI   0(3),C')'                                                10541874
         BC    8,CNQ                                                    10541875
         BC    7,LP3                                                    10541876
CBIN3    CLI   0(3),C')'                                                10541877
         BC    7,LG2                                                    10541878
CNQ      LR    5,2            CONVERT TO BINARY AND STORE IT TO QORS+2  10541879
         LR    2,3                                                      10541880
         BCTR  3,0                                                      10541881
         SR    3,5                                                      10541882
         AH    3,N112                                                   10541883
         STC   3,*+5                                                    10541884
         PACK  TEMP(8),0(0,5)                                           10541885
         CVB   3,TEMP                                                   10541886
         STH   3,QORS+2                                                 10541887
         BC    15,SFS                                                   10541888
*                                                                       10541889
***   ENTRANCE TO FIELD SELECT CARD                                     10541890
*                                                                       10541891
FS       TM    FSW,X'F0'      IS FIELD SELECT POSSIBLE                  10541892
         BC    8,LG5          NO, UNNECESSARY CARD                      10541893
         LA    2,CRDAR+6                                                10541894
         BC    0,FSIN                                                   10541895
         OI    *-3,X'F0'                                                10541896
         MVI   FSW,X'F0'      CLEAR ENFORCED SWITCH                     10541897
         XC    NOFS(2),NOFS   SET NOFS ZERO                             10541898
         LA    7,NOFS+2       SET REGISTER 7                            10541899
*                                                                       10541900
***   FIELD SELECT CARD                                                 10541901
*                                                                       10541902
FSIN     LH    4,NOFS                                                   10541903
         AH    4,N1                                                     10541904
         CVD   4,TEMP                                                   10541905
         UNPK  MSSG4(3),TEMP+6(2)                                       10541906
         OI    MSSG4+2,X'F0'                                            10541907
         CLC   0(3,2),HD10    IS '(K,'                                  10541908
         BC    7,INKEY        NO, BRANCH TO INKEY                       10541909
         LA    2,3(2)         YES, SET BITS                             10541910
         MVI   0(7),X'80'                                               10541911
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10541912
         LA    9,4(7)         AND STORE IN R7+4                         10541913
         BAL   6,BIN                                                    10541914
         DC    C') '                                                    10541915
         CLI   0(2),C','      IS ','                                    10541916
         BC    7,LG4          NO, ILLEGAL FORMAT                        10541917
         LA    2,1(2)                                                   10541918
         BC    15,*+22        YES                                       10541919
INKEY    MVI   0(7),X'00'                                               10541920
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10541921
         LA    9,4(7)         AND STORE IN R7+4                         10541922
         BAL   6,BIN                                                    10541923
         DC    C', '                                                    10541924
         CLI   0(2),C'('      IS '('                                    10541925
         BC    8,FLDL         YES, BRANCH TO FLDL                       10541926
         NI    0(7),X'9F'     NO, SET BITS                              10541927
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10541928
         LA    9,10(7)        AND STORE IN R7+10                        10541929
         BAL   6,BIN                                                    10541930
         DC    C', '                                                    10541931
         XC    8(2,7),8(7)                                              10541932
         BC    15,FSOUT                                                 10541933
FLDL     CLI   1(2),C'P'      IS 'P'                                    10541934
         BC    7,UCOM         NO, BRANCH TO UCOM                        10541935
         OI    0(7),X'20'     YES, SET BIT                              10541936
         BC    15,PUCOM                                                 10541937
UCOM     CLI   1(2),C'U'      IS 'U'                                    10541938
         BC    7,XCOM         NO, BRANCH TO XCOM                        10541939
         OI    0(7),X'40'     YES, SET BIT                              10541940
PUCOM    CLI   2(2),C','      IS ','                                    10541941
         BC    7,LG4          NO, ILLEGAL FORMAT                        10541942
         LA    2,3(2)                                                   10541943
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10541944
         LA    9,8(7)         AND STORE IN R7+8                         10541945
         BAL   6,BIN                                                    10541946
         DC    C', '                                                    10541947
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10541948
         LA    9,10(7)        AND STORE IN R7+10                        10541949
         BAL   6,BIN                                                    10541950
         DC    C') '                                                    10541951
         BC    15,LFSP                                                  10541952
XCOM     CLI   1(2),C'X'      IS 'X'                                    10541953
         BC    7,LG4          NO, ILLEGAL FORMAT                        10541954
         OI    0(7),X'60'     YES, SET BIT                              10541955
         CLI   2(2),C','      IS ','                                    10541956
         BC    7,LG4          NO, ILLEGAL FORMAT                        10541957
         LA    2,3(2)                                                   10541958
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10541959
         LA    9,10(7)        AND STORE IN R7+10                        10541960
         BAL   6,BIN                                                    10541961
         DC    C') '                                                    10541962
         XC    8(2,7),8(7)                                              10541963
LFSP     CLI   0(2),C','      IS ','                                    10541964
         BC    7,LG4          NO, ILLEGAL FORMAT                        10541965
         LA    2,1(2)                                                   10541966
FSOUT    CLC   0(3,2),HD10    IS '(K,'                                  10541967
         BC    7,ONKEY        NO, BRANCH TO ONKEY                       10541968
         LA    2,3(2)                                                   10541969
         OI    0(7),X'10'     YES, SET BIT                              10541970
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10541971
         LA    9,6(7)         AND STORE IN R7+6                         10541972
         BAL   6,BIN                                                    10541973
         DC    C') '                                                    10541974
         BC    15,INOFS                                                 10541975
ONKEY    LR    3,2                                                      10541976
         LA    4,1                                                      10541977
         LA    5,3(2)                                                   10541978
LOP      CLI   0(3),X'F0'                                               10541979
         BC    4,LG4                                                    10541980
         CLI   0(3),X'F9'                                               10541981
         BC    2,LG4                                                    10541982
         BXH   3,4,CBN                                                  10541983
         CLI   0(3),C'/'                                                10541984
         BC    8,CBN+16                                                 10541985
         CLI   0(3),C' '                                                10541986
         BC    7,LOP                                                    10541987
         BC    8,CBN+16                                                 10541988
CBN      CLI   0(3),C'/'                                                10541989
         BC    8,*+12                                                   10541990
         CLI   0(3),C' '                                                10541991
         BC    7,LG4                                                    10541992
         LR    5,2                                                      10541993
         LR    2,3                                                      10541994
         BCTR  3,0                                                      10541995
         SR    3,5                                                      10541996
         AH    3,N112                                                   10541997
         STC   3,*+5                                                    10541998
         PACK  TEMP(8),0(0,5)                                           10541999
         CVB   3,TEMP                                                   10542000
         STH   3,6(7)                                                   10542001
INOFS    LH    3,NOFS         INCREASE NOFS BY 1                        10542002
         AH    3,N1                                                     10542003
         STH   3,NOFS                                                   10542004
         TM    0(7),X'10'     IS KEY SPECIFIED                          10542005
         AH    7,N12          INCREASE REGISTER 7 BY 12                 10542006
         BC    8,CONT         NO                                        10542007
         CLI   0(2),C'/'      IS '/'                                    10542008
         BC    7,*+12         NO                                        10542009
         LA    2,1(2)                                                   10542010
         BC    15,FSIN        YES, BRANCH TO FSIN                       10542011
         CLI   0(2),C' '      IS BLANK                                  10542012
         BC    7,LG4          NO, ILLEGAL FORMAT                        10542013
         BC    15,INPUT       YES, READ NEXT CARD                       10542014
CONT     CLI   1(2),C'/'      IS '/'                                    10542015
         BCTR  2,0                                                      10542016
         BC    7,INPUT        NO, READ NEXT CARD                        10542017
         LA    2,2(2)                                                   10542018
         BC    15,FSIN                                                  10542019
*                                                                       10542020
***   HEADER CARD                                                       10542021
*                                                                       10542022
HD       MVC   HEAD(74),CRDAR+6    STORE HEADING LINE                   10542023
         BC    15,INPUT                                                 10542024
HDSD     MVC   HEAD+74(70),CRDAR+6 STORE HEADING LINE                   10542025
         BC    15,INPUT                                                 10542026
*                                                                       10542027
***   CONSTANT                                                          10542028
*                                                                       10542029
         CNOP  0,8                                                      10542030
CCB      DC    F'0'                                                     10542031
         DC    X'0004'                                                  10542032
         DC    YL2(CCW)                                                 10542033
CCW      DC    X'02'                                                    10542034
         DC    AL3(CRDAR)                                               10542035
         DC    X'00000050'                                              10542036
CCBL     DC    F'0'                                                     10542037
         DC    X'0014'                                                  10542038
         DC    YL2(CCWL)                                                10542039
CCWL     DC    X'09'                                                    10542040
         DC    AL3(LOGAR)                                               10542041
         DC    X'00000050'                                              10542042
TEMP     DS    D                                                        10542043
N64K     DC    X'0000FFFF'                                              10542044
N1       DC    X'0001'                                                  10542045
N12      DC    X'000C'                                                  10542046
N112     DC    X'0070'                                                  10542047
CRDAR    DS    CL80                                                     10542048
         DC    C' '                                                     10542049
LOGAR    DS    CL39                                                     10542050
FSW      DC    X'00'                                                    10542051
REQPA    DC    X'00'                                                    10542052
HD1      DC    CL3'// '                                                 10542053
HD2      DC    CL3'FS '                                                 10542054
HD3      DC    CL3'H1 '                                                 10542055
HD4      DC    CL3'H2 '                                                 10542056
HD5      DC    CL3'END'                                                 10542057
HD6      DC    CL3'A=('                                                 10542058
HD7      DC    CL2'K='                                                  10542059
HD8      DC    CL2'D='                                                  10542060
HD9      DC    CL3'B=('                                                 10542061
HD10     DC    CL3'(K,'                                                 10542062
HD11     DC    CL3'Q=('                                                 10542063
MSSG1    DC    C'END CARD MISSING'                                      10542064
MSSG2    DC    C'  ILLEGAL FORMAT'                                      10542065
         DC    C'. UTILITY MODIFI'                                      10542066
         DC    C'ER CARD'                                               10542067
MSSG3    DC    C'FIELD SELECT CAR'                                      10542068
         DC    C'D MISSING'                                             10542069
MSSG4    DC    C'    ILLEGAL FORM'                                      10542070
         DC    C'AT. FIELD SELECT'                                      10542071
         DC    C' CARD'                                                 10542072
MSSG5    DC    C'FIELD SELECT CAR'                                      10542073
         DC    C'D NOT EXPECTED'                                        10542074
MSSG6    DC    C'INVALID CONTROL '                                      10542075
         DC    C'CARD'                                                  10542076
         ORG   SORS+4078                                                10542077
NOFS     DS    H                                                        10542078
         END   STRT                                                     10542079
         TITLE 'PHASE 2   TAPE TO TAPE'                                 10542080
STAR     START 2752                                                     10542081
START    BALR  15,0                                                     10542082
         USING *,15                                                     10542083
*                                                                       10542084
**** TAPE TO TAPE                                                       10542085
*                                                                       10542086
*                                                                       10542087
***      MAIN LINE DIAGNOSTIC ROUTINE                                   10542088
*                                                                       10542089
SORS     EQU   2500                                                     10542090
QORS     EQU   2504                                                     10542091
IRCLN    EQU   2508                                                     10542092
IBKSZ    EQU   2510                                                     10542093
ORCLN    EQU   2512                                                     10542094
OBKSZ    EQU   2514                                                     10542095
TPGM     EQU   2516                                                     10542096
TJOB     EQU   2517                                                     10542097
FRCD     EQU   2518                                                     10542098
DOPTN    EQU   2519                                                     10542099
POPTN    EQU   2520                                                     10542100
LABSW    EQU   2521                                                     10542101
ICU      EQU   2522                                                     10542102
OCU      EQU   2523                                                     10542103
IBKC     EQU   2524                                                     10542104
OBKC     EQU   2528                                                     10542105
LABIH    EQU   2532                                                     10542106
LABOH    EQU   2534                                                     10542107
LABIT    EQU   2536                                                     10542108
LABOT    EQU   2538                                                     10542109
LABOR    EQU   2540                                                     10542110
AAST     EQU   2542                                                     10542111
LABRTN   EQU   2544                                                     10542112
IPA      EQU   2546                                                     10542113
OPA      EQU   2548                                                     10542114
INA      EQU   2550                                                     10542115
INB      EQU   2552                                                     10542116
OUTA     EQU   2554                                                     10542117
OUTB     EQU   2556                                                     10542118
UCLIM    EQU   2558                                                     10542119
SWHD     EQU   2560                                                     10542120
NOIO     EQU   2561                                                     10542121
DSTBL    EQU   2706                                                     10542122
FIRSTY   LA    8,ERRTN                                                  10542123
         LA    7,ER00                  PRINT PROGRAM NAME               10542124
         BALR  14,8                                                     10542125
         LH    11,ZERO                  ZERO ERROR COUNTER              10542126
         TM    LABSW,X'01'             IS THERE A UTIL CARD ERROR       10542127
         BC    8,*+10                  NO                               10542128
         LA    7,ER3                                                    10542129
         BALR  14,8                                                     10542130
         LH    1,20                    COMMUNICATION REG ADDRESS        10542131
         SR    3,3                     ZERO REG THREE                   10542132
         SR    2,2                     ZERO REG 2                       10542133
         IC    2,9(1)                  GET CONFG BYTE                   10542134
         SRL   2,5                                                      10542135
         LH    1,ATEK                                                   10542136
         SLL   1,0(2)                  AMOUNT OF CORE AVAILABLE         10542137
         SH    1,ONE                                                    10542138
         TM    0(1),X'5C'              ASTERISK  IF YES NO LABELS       10542139
         BC    1,SUBT                                                   10542140
         OI    LABSW,X'20'             SET LABEL ECIST SWITCH           10542141
REPEAT   SH    1,ATEY3                 POINT TO THE NEXT LOCATI         10542142
         AH    3,ONE                   NUMBER OF LABELS IN REG 3        10542143
         TM    0(1),X'5C'              IS IT AN ASTERISK                10542144
         BC    12,REPEAT                                                10542145
         CH    3,ONE                   MORE THAN ONE LABEL              10542146
         BC    2,SUBT                  NUMBER OF LABELS IS 2            10542147
         OI    LABSW,X'40'             NUMBER OF LABELS IS 1            10542148
SUBT     STH   1,AAST                  STORE THE ASTERISK ADDRE         10542149
         STC   1,ER00                  TEST FOR HALF WORD ALIGNMENT     10542150
         TM    ER00,X'01'              IS IT ODD ALIGNMENT              10542151
         BC    8,SUBTRT                                                 10542152
         SH    1,ONE                   ALLIGN ON A  AHLF WORD BOUNDARY  10542153
SUBTRT   SH    1,TWO                   SUBT INST LENGTH                 10542154
         MVC   0(2,1),BRANCH           MOVE   BRANCH TO PHASE 4         10542155
         STH   1,UCLIM                                                  10542156
AA       TM    TPGM,X'22'              TAPE TO TAPE                     10542157
         BC    1,A1                                                     10542158
         LA    7,ER0                    LOAD  ADDRESS                   10542159
         BALR  14,8                    GO TO ERROR ROUTINE              10542160
A1       LH    1,22                     REG 1 CONTAINS THE PUB ADDRESS  10542161
         TM    14(1),X'FF'             TAPE INPUT                       10542162
         BC    8,CLC                                                    10542163
         LA    7,ER1                    LOAD  ADDRESS                   10542164
         BALR  14,8                    GO TO ERROR ROUTINE              10542165
CLC      CLC   25(2,1),ZERO            IS THE UNIT ASSIGNED             10542166
         BC    8,A2                                                     10542167
         MVI   IPA+1,X'18'             MOVE ALTERNATE INPUT DEVICE DSP  10542168
         TM    26(1),X'FF'                                              10542169
         BC    8,A2                                                     10542170
         LA    7,ER1                   NON TAPE UNIT MESSAGE            10542171
         BALR  14,8                                                     10542172
A2       TM    18(1),X'FF'             TAPE OUTPUT                      10542173
         BC    8,A14                                                    10542174
         LA    7,ER2                    LOAD  ADDRESS                   10542175
         BALR  14,8                    GO TO ERROR ROUTINE              10542176
A14      CLC   29(2,1),ZERO            IS THE UNIT ASSIGNED             10542177
         BC    8,A4                                                     10542178
         MVI   OPA+1,X'1C'                                              10542179
         TM    30(1),X'FF'                                              10542180
         BC    8,A4                                                     10542181
         LA    7,ER2                                                    10542182
         BALR  14,8                                                     10542183
A4       TM    TJOB,X'0F'               TYPE C,F,RF,OR R                10542184
         BC    4,A5                                                     10542185
         OI    SWIT,X'20'              SET INVALID PROG TYPE SWIT       10542186
         LA    7,ER6                    LOAD  ADDRESS                   10542187
         BALR  14,8                    GO TO ERROR ROUTINE              10542188
A5       TM    DOPTN,X'F0'             TAPE INPUT  OPTION VALID         10542189
         BC    4,A6                                                     10542190
         OI    SWIT,X'02'              INVALID INPUT  OPTION            10542191
         LA    7,ER11                   LOAD  ADDRESS                   10542192
         BALR  14,8                    GO TO ERROR ROUTINE              10542193
A6       TM    DOPTN,X'0E'             TAPE OUTPUT OPTION VALID         10542194
         BC    4,A7                                                     10542195
         OI    SWIT,X'08'              INVALID OUTPUT OPTION            10542196
         LA    7,ER12                   LOAD  ADDRESS                   10542197
         BALR  14,8                    GO TO ERROR ROUTINE              10542198
A7       TM    TJOB,X'01'              TYPE COPY                        10542199
         BC    1,A8                                                     10542200
         TM    FRCD,X'01'              FIXED LENGTH INPUT               10542201
         BC    1,A8                                                     10542202
         LA    7,ER5                    LOAD  ADDRESS                   10542203
         BALR  14,8                    GO TO ERROR ROUTINE              10542204
A8       TM    FRCD,X'06'              VARIABLE OR UNDEFINED            10542205
         BC    4,OUTPUT                                                 10542206
         CLC   ORCLN(2),FOR096         ORL GREATER THAN 4096            10542207
         BC    13,A9                                                    10542208
         LA    7,ER9                    LOAD  ADDRESS                   10542209
         BALR  14,8                    GO TO ERROR ROUTINE              10542210
A9       LH    3,OBKSZ                 OBKSZ GREATER THAN 5(ORL)        10542211
         N     3,ANDOP                                                  10542212
         SR    2,2                     ZERO REG 2                       10542213
         LH    4,ORCLN                 LOAD REG 4 WITH ORCLN            10542214
         DR    2,4                     DIVIDE                           10542215
         LTR   2,2                     REMAINDER                        10542216
BC       BC    8,OUTPUT                                                 10542217
         LA    7,ER10                   LOAD  ADDRESS                   10542218
         BALR  14,8                    GO TO ERROR ROUTINE              10542219
OUTPUT   TM    FRCD,X'06'              VARIABLE OR UNDEFINED            10542220
         BC    4,A11A                                                   10542221
         CLC   IRCLN(2),FOR096         IRL GREATER THAN 4096            10542222
         BC    13,A10                                                   10542223
         LA    7,ER7                    LOAD  ADDRESS                   10542224
         BALR  14,8                    GO TO ERROR ROUTINE              10542225
A10      LH    3,IBKSZ                 IBL EQUAT TO K(IRL)              10542226
         N     3,ANDOP                                                  10542227
         SR    2,2                     ZERO REG 2                       10542228
         LH    4,IRCLN                 PUT IRCLN IN REG 4               10542229
         DR    2,4                     DIVIDE                           10542230
         LTR   2,2                     IS THERE A REMAINDER             10542231
         BC    8,A11A                                                   10542232
         LA    7,ER8                                                    10542233
         BALR  14,8                    GO TO ERROR ROUTINE              10542234
A11A     CLC   IRCLN(2),ORCLN          I/O RECORD LENGTHS THE SAME      10542235
         BC    8,A11                                                    10542236
         TM    TJOB,X'0A'              FIELD SELECT SPECIFIED           10542237
         BC    4,A11                   YES                              10542238
         LA    7,ER26                                                   10542239
         BALR  14,8                                                     10542240
A11      TM    FRCD,X'01'              FIXED LENGTH INPUT               10542241
         BC    1,RP                                                     10542242
         TM    TJOB,X'0E'              OPTIONS OTHER THAN COPY          10542243
         BC    8,RP                                                     10542244
         LA    7,ER6                                                    10542245
         BALR  14,8                                                     10542246
         BC    15,RP                                                    10542247
ERRTN    MVC   ER00(36),0(7)           MOVE MESSAGE TO PRINT AREA       10542248
         AH    11,ONE                   ADD 1 TO ERROR COUNTER          10542249
         SH    7,ONE                                                    10542250
         MVC   COM+7(1),0(7)           MOVE LENGTH TO BE PRINTED        10542251
         SVC   0                                                        10542252
         DC    YL2(CCB)                                                 10542253
         TM    CCB+2,X'80'              WRITE FINISHED                  10542254
         BC    8,*-4                                                    10542255
         BCR   15,14                                                    10542256
*                                                                       10542257
***      MAIN LINE CONTROL                                              10542258
*                                                                       10542259
RP       LH    9,UCLIM                                                  10542260
         LH    0,ZERO                  ZERO REG ZERO                    10542261
         SR    10,10                                                    10542262
         SR    1,1                                                      10542263
RP1      TM    TJOB,X'0A'               REBLOCK AND /OR FIELD SELECT    10542264
         BC    9,REBL                                                   10542265
         LH    0,NOFS                                                   10542266
***  THIS REGISRER IS USED TO NUMBER THE FIELD SELECT ERROR MESSAGES    10542267
         LR    10,0                    GET CURRENT FS CARD ENTRY FROM   10542268
         LA    10,1(10)                ADD ONE TO REG 10                10542269
         LR    1,0                     GET THE NUMBER OF FS ENTRIES     10542270
         BCTR  1,0                                                      10542271
         MH    1,TWELVE                POINT TO THE LAST ONE            10542272
RP2      SH    0,ONE                                                    10542273
         BCTR  10,0                    POINT TO THE NEXT ENTRY          10542274
         LA    7,NOFS+2(1)                                              10542275
         TM    0(7),X'60'              PACK OR UNPACK                   10542276
         BC    1,WRONG                                                  10542277
         BC    4,CC                    GO MODIJY REGS FOR DIAGNOSTICS   10542278
         MVC   ER16+32(4),ER43         MOVE FS TO ERROR MESSAGE         10542279
         MVC   ER31+4(4),ER43                                           10542280
         L     4,NOFS+10(1)                4          B                 10542281
         LR    6,4                                                      10542282
ZUTI     LH    2,NOFS+6(1)             REG 2 CONTAINS A                 10542283
         LH    3,NOFS+8(1)                  3          C                10542284
         BCTR  2,0                                                      10542285
         BCTR  3,0                                                      10542286
         LTR   4,4                     N EQUAL ZERO TEST                10542287
         BC    8,UDOPE                                                  10542288
         LR    5,2                          5          A                10542289
         LR    7,3                          7          C                10542290
         AR    5,4                          5          A+B              10542291
         AR    7,6                         7         C+B(M)             10542292
         CH    5,IRCLN                  A+B GREATER INPUT REC LENGTH    10542293
         BC    2,ERRORA                                                 10542294
         CH    7,ORCLN                  C+B         OUTPUT              10542295
         BC    2,ERRORA                                                 10542296
         LA    2,1(2)                                                   10542297
         LA    3,1(3)                                                   10542298
          LA    7,NOFS+2(1)                                             10542299
         TM    0(7),X'60'              PACK OR UNPACK                   10542300
         BC    4,BB                    GO TO PACK OR UNPACK             10542301
         BAL   14,GG                                                    10542302
         BC    15,L                                                     10542303
L        CH    0,ZERO                  ALL FIELD SELECT PATAMETERS      10542304
         BC    2,ADER                                                   10542305
Q        STH   9,UCLIM                  STORE ADDR IN UTIL COMM TAB     10542306
         TM    ICU,X'FF'               DID USER SUPPLY OWN LABELS       10542307
         BC    12,MAXIY                NO                               10542308
         SH    9,LABRTN                YES SUBT USERS LAST ADDR + 1     10542309
         MVC   CHANGE+6(2),*-2         MOVE LAST ADDR ADDRESS TO ASSGN  10542310
         BC    15,MAXY                                                  10542311
MAXIY    TM    LABSW,X'60'             IS THERE LABEL CHECKING          10542312
         BC    1,EITHER                EITHER INPUT OR OUTPUT           10542313
         BC    4,BIPOP                 BOTH INPUT AND OUTPUT            10542314
         SH    9,LABRTN                NO- SUBT ADDR OF PHASE4          10542315
         MVC   CHANGE+6(2),*-2         MOVE LAST ADDR ADDRESS TO ASSGN  10542316
         BC    15,MAXY                                                  10542317
BIPOP    SH    9,LABOR                 SUBT BOTH INPUT AND OUTPUT       10542318
         MVC   CHANGE+6(2),*-2         MOVE LAST ADDR ADDRESS TO ASSGN  10542319
         BC    15,MAXY                                                  10542320
EITHER   LH    2,AAST                  LOAD ASTERISK ADDRESS            10542321
         CLC   1(4,2),UIN              COMPARE LABEL TO UIN             10542322
         BC    8,LABIPT                GO TO LABEL INPUT RTN            10542323
         SH    9,LABOT                 SUBT LABEL OUTPUT ROUTINE        10542324
         MVC   CHANGE+6(2),*-2         MOVE ADDRESS IN ASSGN INST       10542325
         BC    15,MAXY                                                  10542326
LABIPT   TM    DOPTN,X'10'             MULTIPLE RELL TEST               10542327
         BC    1,NOMR                                                   10542328
         SH    9,INA                   NO-SUBT INPUT TRAILER LABEL      10542329
         MVC   CHANGE+6(2),*-2         MOVE ADDRESS IN ASSGN INST       10542330
         BC    15,MAXY                                                  10542331
NOMR     SH    9,LABIT                 SUBT UNPUT LAB SINCE MULT REEL   10542332
         MVC   CHANGE+6(2),*-2         MOVE ADDRESS IN ASSGN INST       10542333
MAXY     STH   9,MAXIO                 STORE AVAILABLE CORE FOR I/O     10542334
         TM    TJOB,X'01'               TYPE COPY                       10542335
         BC    1,ASSIGN                                                 10542336
         MVI   CHANGE+1,X'80'                                           10542337
         BC    15,ASSIGN                                                10542338
ADER     SH    1,TWELVE                                                 10542339
         BC    15,RP2                                                   10542340
REBL     TM    TJOB,X'04'                                               10542341
         BC    8,Q                                                      10542342
         LH    4,IRCLN                                                  10542343
         LH    2,ONE                                                    10542344
         LH    3,ONE                                                    10542345
         BAL   14,GG                                                    10542346
         BC   15,Q                                                      10542347
ERRORA   LA    7,ER16                                                   10542348
         BAL   14,CVD                                                   10542349
         UNPK  ER16(3),OUTARA(8)                                        10542350
         BALR  14,8                    GO TO ERROR ROUTINE              10542351
         BC    15,L                                                     10542352
CC       LH    4,NOFS+10(1)            REG 4 CONTAINS N                 10542353
         LH    6,NOFS+12(1)                6          M                 10542354
         TM    0(7),X'40'                                               10542355
         BC    1,UNPKR                                                  10542356
         MVC   ER16+32(4),ER45         MOVE PACK TO ERROR MESSAGE       10542357
         MVC   ER31+4(4),ER45                                           10542358
         BC    15,ZUTI                                                  10542359
UNPKR    MVC   ER16+32(4),ER44         MOVE UNPK TO ERROR MESSAGE       10542360
         MVC   ER31+4(4),ER44                                           10542361
         BC    15,ZUTI                                                  10542362
UDOPE    LA    7,ER31                  N EQUALS ZERO                    10542363
         BAL   14,CVD                                                   10542364
         UNPK  ER31(3),OUTARA(8)                                        10542365
         BALR  14,8                                                     10542366
         BC    15,L                                                     10542367
WRONG    LA    7,ERWR                                                   10542368
         BAL   14,CVD                                                   10542369
         UNPK  ERWR(3),OUTARA(8)                                        10542370
         BALR  14,8                                                     10542371
         BC    15,L                                                     10542372
*                                                                       10542373
***      PACK ROUTINE                                                   10542374
*                                                                       10542375
BB       LA    7,NOFS+2(1)             MOVE ADDRESS OF TYPE INTO REG 7  10542376
         TM    0(7),X'20'              IS IT PACK                       10542377
         BC    8,Z                                                      10542378
         LH    2,NOFS+6(1)              REG 2 CONTAINS A                10542379
         LH    3,NOFS+8(1)                  3          C                10542380
         LH    4,NOFS+10(1)                 4          N                10542381
         LH    5,NOFS+12(1)                 5          M                10542382
         AH    2,XSIX                       2          A AND REG 6      10542383
         AH    3,XTEN                       3          C         10     10542384
         SH    2,ONE                   SUBT 1,1 FROM A,C                10542385
         SH    3,ONE                                                    10542386
         STH   2,PACK2+4               STORE A AND REGS IN PACK         10542387
         STH   3,PACK2+2                                                10542388
         STH   3,XCL+2                 STORE C AND REGS IN PACK AND XC  10542389
         STH   3,XCL+4                                                  10542390
         CH    4,SIXTEN                 N LESS OR EQUAL TO 16           10542391
         BC    12,LES2                                                  10542392
         AR    2,4                     ADD N-1,M-1 TO A,C               10542393
         AR    3,5                                                      10542394
         SH    2,ONE                   SUBT U,1 FROM A,C                10542395
         SH    3,ONE                                                    10542396
BETA     CH    4,SIXTEN                 N LESS OR EQUAL TO 16           10542397
         BC    12,LES2                                                  10542398
         SH    2,FORTEN                SUBT 14,7 FROM A,C               10542399
         SH    3,SEVEN                                                  10542400
         STH   2,PACK1+4               A AND C IN INSTRUCTION           10542401
         STH   3,PACK1+2                                                10542402
         SH    4,FORTEN                 SUBT(14,7) FROM (A,C)AND (N,M)  10542403
         SH    5,SEVEN                                                  10542404
         SH    9,SIX                    SUBT INST LENGTH                10542405
         MVC   0(6,9),PACK1            MOVE TO UPPER CORE               10542406
         BC    15,BETA                                                  10542407
LES2     CH    5,ONE                   M LESS THAN 2                    10542408
         BC    4,ERRO1                                                  10542409
         CH    5,SIXTEN                M GREZTER THAN 16                10542410
         BC    12,GEBER                                                 10542411
         CH    5,TWO56                 M GREATER THAN 256               10542412
         BC    2,ERRO1                                                  10542413
         SH    5,ONE                   SUBT ONE FROM M                  10542414
         STC   5,XCL+1                 STORE LENGTH IN EXCLUSIVE OR     10542415
         SH    3,FORTEN                SUBT 14 FROM C AND REGS          10542416
         STH   3,PACK2+2                                                10542417
         SH    4,ONE                   SUBT ONE FROM N                  10542418
         STC   4,PACK2+1               STORE N-1                        10542419
         MVZ   PACK2+1(1),KONST        PUT 15 UN INST LENGTH            10542420
         SH    9,TWELVE                SUBT INST LENGTH                 10542421
         MVC   0(12,9),XCL             MOVE INSTRUCTIONS TO UPPER CORE  10542422
         BC    15,L                                                     10542423
GEBER    SH    4,ONE                   SUBT 1,1 FROM N,M                10542424
         SH    5,ONE                    GET 1 BYTE LENGTH               10542425
         SLA   5,4                      AND                             10542426
         AR    5,4                      STORE                           10542427
         STC   5,PACK2+1                                                10542428
         SH    9,SIX                    SUBT INST LENGTH                10542429
         MVC   0(6,9),PACK2             MOVE TO UPPER CORE              10542430
         BC    15,L                                                     10542431
*                                                                       10542432
***      UNPACK ROUTINE                                                 10542433
*                                                                       10542434
Z        LH    2,NOFS+6(1)              REG 2 CONTAINS A                10542435
         LH    3,NOFS+8(1)                  3          C                10542436
         LH    4,NOFS+10(1)                 4          N                10542437
         LH    5,NOFS+12(1)                 5          M                10542438
         AH    2,XSIX                       2          A AND REG 6      10542439
         AH    3,XTEN                       3          C AND REG 10     10542440
         SH    2,ONE                     SUBT 1,1 FROM A,C              10542441
         SH    3,ONE                                                    10542442
         STH   2,UNPK2+4                 STORE A,C IN UNPACK2           10542443
         STH   3,UNPK2+2                                                10542444
         STH   3,MVI+2                                                  10542445
         STH   3,MVC+4                                                  10542446
         AH    3,ONE                                                    10542447
         STH   3,MVC+2                                                  10542448
         SH    3,ONE                                                    10542449
         CH    4,EIGHT                  N LESS OR EQUAL TO 8            10542450
         BC    12,LES                                                   10542451
         AR    2,4                      A AND C NOW POINT TO THE LAST   10542452
         AR    3,5                      BYTE +1 OF THEIR AREAS          10542453
         SH    2,ONE                     SUBT 1,1 FROM A,C              10542454
         SH    3,ONE                                                    10542455
ALPHA    CH    4,EIGHT                  N LESS OR EQUAL TO 8            10542456
         BC    12,LES                                                   10542457
         SH    2,SEVEN                                                  10542458
         SH    3,FORTEN                  SUBT 7,14 FROM A,C , N,M       10542459
         SH    4,SEVEN                                                  10542460
         SH    5,FORTEN                                                 10542461
         STH   2,UNPK1+4                                                10542462
         STH   3,UNPK1+2                                                10542463
         SH    9,SIX                    MOVE TO                         10542464
         MVC   0(6,9),UNPK1             UPPER CORE                      10542465
         BC    15,ALPHA                                                 10542466
LES      CH    5,ONE                   M LESS THAN ONE                  10542467
         BC    4,ERRO                                                   10542468
         CH    5,SIXTEN                M GREATER THAN 16                10542469
         BC    12,GEBER1                                                10542470
         CH    5,TWO56                 M GREATER THAN 256               10542471
         BC    2,ERRO                                                   10542472
         SH    5,ONE                   SUBT ONE FROM M                  10542473
         STC   5,MVC+1                   STORE LENGTH                   10542474
         SH    3,FORTEN                  SUBT 14 FROM C                 10542475
         STH   3,UNPK2+2               STORE C AND REGS IN INST         10542476
         SH    4,ONE                   SUBT ONE FROM N                  10542477
         STC   4,UNPK2+1                 STORE N                        10542478
         MVZ   UNPK2+1(1),UNPK1+1      STORE M IN LENGTH                10542479
         SH    9,SIXTEN                  SUBT INST LENGTH               10542480
         MVC   0(16,9),MVI               MOVE TO UPPER CORE             10542481
         STH   9,UCLIM                 STORE UPPER CORE LIMIT           10542482
         BC    15,L                                                     10542483
GEBER1   SH    4,ONE                   SUBT ONE FROM(N,M)               10542484
         SH    5,ONE                                                    10542485
ASTER    SLA   5,4                      GET ONE BYTE LENGTH MIN         10542486
         AR    5,4                                                      10542487
         STC   5,UNPK2+1                LENGTH IS STORED                10542488
         SH    9,SIX                                                    10542489
         MVC   0(6,9),UNPK2                                             10542490
         BC    15,L                                                     10542491
*                                                                       10542492
***    GENERATE ROUTINE FOR FIELD SELECT AND REBLOCKING                 10542493
*                                                                       10542494
GG       LH    5,TWO56                 REG 5 CONTAINS 256               10542495
         LR    7,5                          7          255              10542496
         SH    7,ONE                                                    10542497
         AH    2,XSIX                       2          A AND REG 6      10542498
         AH    3,XTEN                       3          C AND REG 10     10542499
         BCTR  2,0                                                      10542500
         BCTR  3,0                                                      10542501
BACK     CR    4,5                      B LESS OR EQUAL TO 256          10542502
         BC    12,LAST                                                  10542503
         STH   2,MOVE+4                 NO - STORE A AND C              10542504
         STH   3,MOVE+2                                                 10542505
         AR    2,5                      ADD 256 TO A AND C              10542506
         AR    3,5                                                      10542507
         STC   7,MOVE+1                 STORE 255 IN DUMMY INST         10542508
         SR    4,5                      SUBT  256 FROM B                10542509
         SH    9,SIX                   SUBT INST LENGTH                 10542510
         MVC   0(6,9),MOVE             MOVE INST TO UPPER CORE          10542511
         BC    15,BACK                                                  10542512
LAST     STH   2,MOVE+4                GENERATE LAST MOVE               10542513
         STH   3,MOVE+2                                                 10542514
         SH    4,ONE                   SUBT ONE FROM B                  10542515
         STC   4,MOVE+1                                                 10542516
         SH    9,SIX                   SUBT INST LENGTH                 10542517
         MVC   0(6,9),MOVE             MOVE INST TO UPPER CORE          10542518
         BCR   15,14                    RETURN                          10542519
*                                                                       10542520
***     ASSIGN  IO  AREAS                                               10542521
*                                                                       10542522
ASSIGN   OI    SWIT,X'01'                                               10542523
         TM    TJOB,X'01'              COPY                             10542524
         BC    8,COPYER                                                 10542525
         CLC   IBKSZ(2),OBKSZ          BLOCK SIZES MUST BE EQUAL        10542526
         BC    8,COPYER                                                 10542527
         OI    SWIT,X'04'              SUPPRESS IO PRINT WWITCH         10542528
         LA    7,ER10                  INVALID OUTPUT BLOCK LENGTH      10542529
         BALR  14,8                                                     10542530
         BC    15,GOERT                                                 10542531
COPYER   EQU   *                                                        10542532
         LH    2,TWO                                                    10542533
         LH    1,MAXIO                 A EQUALS 2,IO LIMIT IS IN REG 1  10542534
         N     1,ANDOP                 GET RID OF MINUS PROROGATION     10542535
         LR    3,2                          B=2                         10542536
         LH    10,OBKSZ                                                 10542537
         LH    9,IBKSZ                 GET INKSZ IN REG 9               10542538
         N     10,ANDOP                                                 10542539
         N     9,ANDOP                 GET RID OF MINUS                 10542540
RETURN   LR    7,3                                                      10542541
         LR    5,2                                                      10542542
         MR    4,9                                                      10542543
         MR    6,10                                                     10542544
         AR    5,7                                                      10542545
         CR    5,1                                                      10542546
         BC    12,ASGN                 ASSIGN AREAS IF POSSIBLE         10542547
TEST     TM    SWIT,X'01'                   SWITCH ON TEST              10542548
         BC    1,ON                                                     10542549
         OI    SWIT,X'01'                   TURN SWITCH ON              10542550
         SH    3,ONE                   SUBT ONE FROM B                  10542551
         AH    2,ONE                   ADD ONE TO A                     10542552
         LTR   3,3                     B LESS THAN ZERO TEST            10542553
         BC    4,ERROR                      YES                         10542554
         BC    15,RETURN                    NO                          10542555
ON       NI    SWIT,X'FE'                   TURN SWITCH OFF             10542556
         SH    2,ONE                   SUBT ONE FROM A                  10542557
         BC    15,RETURN                                                10542558
ERROR    LA    8,ERRTN                                                  10542559
         LA    7,ER14                   LOAD  ADDRESS                   10542560
         OI    SWIT,X'04'              SET SUPRESS I/O PRINT SWITCH     10542561
         BALR  14,8                    GO TO ERROR ROUTINE              10542562
GOERT    STH   11,FOR096               STORE NUMBER OF ERRORS           10542563
         BC    15,ENDLOG                                                10542564
*                                                                       10542565
***   ACTUAL ASSIGNING OF INPUT OUTPUT AREAS                            10542566
*                                                                       10542567
ASGN     LTR   3,3                                                      10542568
CHANGE   BC    6,TEST                  IF TYPE COPY, BC6, IF NOT BC8    10542569
         LH    6,ZERO                  THIS ADDRESS IS MODIFIED         10542570
         BC    8,STOR3                 IF ZERO, A = 0                   10542571
         STH   6,INA                   STORE ASDRESS IN INA             10542572
         SH    2,ONE                   SUBT ONE FROM A                  10542573
         LTR   2,2                     TEST FOR A ' ZERO                10542574
         BC    8,STOR                                                   10542575
         AR    6,9                                                      10542576
STOR     STH   6,INB                   STOR ADDRESS IN INB              10542577
         LTR   3,3                     B = 0 TEST                       10542578
         BC    8,STOR2                                                  10542579
         AR    6,9                                                      10542580
         STH   6,OUTA                                                   10542581
         SH    3,ONE                                                    10542582
         LTR   3,3                     B = 0 TEST                       10542583
         BC    8,STOR1                                                  10542584
         AR    6,10                                                     10542585
STOR1    STH   6,OUTB                  STORE ADDRESS IN OUT B           10542586
         BC    15,LOG                                                   10542587
STOR2    MVC   INA(2),OUTA             COMBINED I/O AREAS               10542588
         MVC   INB(2),OUTB             MAKE IN AND OUT CORRESPOND       10542589
         BC    15,LOG                                                   10542590
STOR3    STH   6,INA                   STORE ADDRESS IN                 10542591
         STH   6,OUTA                  INA AND POUT A                   10542592
         BCTR  2,0                                                      10542593
         LTR   2,2                                                      10542594
         BC    8,STOR4                 B = 0 TEST                       10542595
         AR    6,10                                                     10542596
STOR4    STH   6,INB                                                    10542597
         STH   6,OUTB                                                   10542598
LOG      SR    7,7                     CLEAR REG 7 TO ZERO              10542599
         CLC   INA(2),INB                                               10542600
         BC     8,*+8                  /NA EQUAL INB  ADD ONLY 16       10542601
         AH    7,SIXTEN                                                 10542602
         AH    7,SIXTEN                                                 10542603
         CLC    OUTA(2),OUTB                                            10542604
         BC    8,*+8                   OUTA EQUAL OUTB  ADD ONLY 1      10542605
         AH     7,ONE                                                   10542606
         AH     7,ONE                                                   10542607
         STC    7,NOIO                                                  10542608
         BC    15,GOERT                                                 10542609
*                                                                       10542610
***      LOG JOB ROUTINE                                                10542611
*                                                                       10542612
ENDLOG   LH    6,IRCLN                                                  10542613
         MVI   CVD+1,X'60'             CHANGE THE REGISTER IN THE CVD   10542614
         TM    FRCD,X'06'              VARIABLE OR UNDEFINED PROCESSING 10542615
         BC    4,*+20                  BYPASS RECORD FORMAT PRINT       10542616
         BAL   14,CVD                                                   10542617
         UNPK  ER18+20(4),OUTARA(8)                                     10542618
         LA    7,ER18                                                   10542619
         BALR  14,8                    GO TO ERROR ROUTINE              10542620
         LH    6,IBKSZ                                                  10542621
         N     6,ANDOP                 GET RID OF MINUS PROPOGATION     10542622
         BAL   14,CVD                                                   10542623
         UNPK  ER19+17(5),OUTARA(8)          IBKSZ                      10542624
         LA    7,ER19                                                   10542625
         BALR  14,8                    GO TO ERROR ROUTINE              10542626
         TM    FRCD,X'06'              VARIABLE OR UNDEFINED PROCESSING 10542627
         BC    4,*+24                  BYPASS RECORD FORMAT PRINT       10542628
         LH    6,ORCLN                                                  10542629
         BAL   14,CVD                                                   10542630
         UNPK  ER20+22(4),OUTARA(8)                                     10542631
         LA    7,ER20                                                   10542632
         BALR  14,8                    GO TO ERROR ROUTINE              10542633
         LH    6,OBKSZ                                                  10542634
         N     6,ANDOP                 GET RID OF MINUS PROPOGATION     10542635
         BAL   14,CVD                                                   10542636
         UNPK  ER21+18(5),OUTARA(8)      OBKSZ                          10542637
         LA    7,ER21                                                   10542638
         BALR  14,8                    GO TO ERROR ROUTINE              10542639
         TM    SWIT,X'02'              TEST FOR INVALID INPUT OPTION    10542640
         BC    1,TM                                                     10542641
         TM    DOPTN,X'10'              INPUT OPTION                    10542642
         BC    1,BCD1                                                   10542643
         TM    DOPTN,X'20'                                              10542644
         BC    1,BCD2                                                   10542645
         TM    DOPTN,X'40'                                              10542646
         BC    1,BCD3                                                   10542647
         MVC   ER22+13(18),ER50        TAPE REWIND UNLOAD               10542648
OUTOPT   LA    7,ER22                                                   10542649
         BALR  14,8                    GO TO ERROR ROUTINE              10542650
TM       TM    SWIT,X'08'              TEST FOR INVALED OPTION          10542651
         BC    1,RETUNR+6                                               10542652
         TM    DOPTN,X'02'              OUTPUT OPTION                   10542653
         BC    1,OPTOPT                TAPE NEITHER                     10542654
         TM    DOPTN,X'04'                                              10542655
         BC    1,OPTTOP                TAPE REWIND                      10542656
         MVC   ER23+14(18),ER50                                         10542657
RETUNR   LA    7,ER23                                                   10542658
         BALR  14,8                    GO TO ERROR ROUTINE              10542659
         TM    SWIT,X'04'              TEST SUPRESS I/O PRINT SWITCH    10542660
         BC    1,LOADZ+6                                                10542661
         TM    TJOB,X'01'              COPY TEST                        10542662
         BC    1,MUV                                                    10542663
         TM    NOIO,X'02'               2 OUTPUT                        10542664
         BC    1,STORTO                                                 10542665
         MVI   ER24+8,X'F1'            PUT 1 IN OUTPUT                  10542666
ZERT     TM    NOIO,X'20'               2 INPUT                         10542667
         BC    1,STORTT                                                 10542668
         MVI   ER24,X'F1'              PUT 1 IN INPUT                   10542669
LOADZ    LA    7,ER24                                                   10542670
         BALR  14,8                    GO TO ERROR ROUTINE              10542671
         TM    FRCD,X'01'              FIXED INPUT                      10542672
         BC    1,FIXED                                                  10542673
         TM    FRCD,X'02'              VARIABLE INPUT                   10542674
         BC    1,VAR                                                    10542675
         MVC   ER32+14(9),ER40         MOVE UNDEFINED TO MESSAGE        10542676
LO       LA    7,ER32                                                   10542677
         BALR  14,8                                                     10542678
         TM    SWIT,X'20'              INVALID PROGRAM TYPE             10542679
         BC    1,WRITE+6                                                10542680
         TM    TJOB,X'01'              TYPE COPY                        10542681
         BC    8,*+14                                                   10542682
         MVC   ER33+5(4),ER39A                                          10542683
         BC    15,WRITE                                                 10542684
         TM    TJOB,X'02'              FIELD SELECT                     10542685
         BC    8,*+14                                                   10542686
         MVC   ER33+5(12),ER39B                                         10542687
         BC    15,WRITE                                                 10542688
         TM    TJOB,X'04'              REBLOCK                          10542689
         BC    8,*+14                                                   10542690
         MVC   ER33+5(7),ER39C                                          10542691
         BC    15,WRITE                                                 10542692
         MVC   ER33+5(21),ER39D        REBLOCK AND FIELD SELECT         10542693
WRITE    LA    7,ER33                                                   10542694
         BALR  14,8                                                     10542695
         LH    11,FOR096                                                10542696
         CH    11,ZERO                                                  10542697
         BC    8,SVC                                                    10542698
         SVC   1                                                        10542699
         DC    C'SYSEOJ'                                                10542700
SVC      SVC   1                                                        10542701
         DC    C'SYSLOD'                                                10542702
OPTOPT   MVC   ER23+14(9),ER46                                          10542703
         BC    15,RETUNR                                                10542704
OPTTOP   MVC   ER23+14(11),ER49                                         10542705
         BC    15,RETUNR                                                10542706
MUV      TM    NOIO,X'02'                                               10542707
         BC    1,STTT                                                   10542708
         MVI   ER25,X'F1'              PUT 1 IN I/O                     10542709
ZIPPY    LA    7,ER25                                                   10542710
         BALR  14,8                    GO TO ERROR ROUTINE              10542711
         BC    15,LOADZ+6                                               10542712
STTT     MVI   ER25,X'F2'              PUT 2 IN I/O                     10542713
         BC    15,ZIPPY                                                 10542714
BCD1     MVC   ER22+13(13),ER45A       TAPE MULTIPLE                    10542715
         BC    15,OUTOPT                                                10542716
BCD2     MVC   ER22+13(16),ER46        NO REWIND UNLOAD                 10542717
         BC    15,OUTOPT                                                10542718
BCD3     MVC   ER22+13(11),ER49        TAPE REWIND                      10542719
         BC    15,OUTOPT                                                10542720
STORTO   MVI   ER24+8,X'F2'            PUT 2 IN OUTPUT                  10542721
         BC    15,ZERT                                                  10542722
STORTT   MVI   ER24,X'F2'              PUT 2 IN INPUT                   10542723
         BC    15,LOADZ                                                 10542724
CVD      CVD   10,OUTARA               CONVERT TO DECIMAL               10542725
         OI    OUTARA+7,X'0F'          PUT SIGN INTO CONVERTED NUMBER   10542726
         BCR   15,14                                                    10542727
FIXED    MVC   ER32+14(9),ER42         MOVE FIXED TO MESSAGE            10542728
         BC    15,LO                                                    10542729
VAR      MVC   ER32+14(9),ER41         MOVE VARIABLE TO MESAGE          10542730
         BC    15,LO                                                    10542731
*                                                                       10542732
***      CONSTANTS                                                      10542733
*                                                                       10542734
         CNOP  0,8                                                      10542735
OUTARA   DC    D'0'                                                     10542736
CCB      DC    F'0'                                                     10542737
         DC    X'0014'                                                  10542738
         DC    YL2(COM)                                                 10542739
COM      DC    X'09'                                                    10542740
         DC    AL3(ER00)                                                10542741
         DC    X'20000032'                                              10542742
ANDOP    DC    X'0000FFFF'                                              10542743
MOVE     MVC   0(0,0),0(0)              DUMMY INST                      10542744
BRANCH   BCR   15,7                                                     10542745
UNPK1    UNPK  0(15,0),0(8,0)                                           10542746
MVI      MVI   0(0),X'F0'                                               10542747
MVC      MVC   0(0,0),0(0)                                              10542748
UNPK2    UNPK  0(0,0),0(0,0)                                            10542749
PACK1    PACK  0(8,0),0(15,0)                                           10542750
XCL      XC    0(0,0),0(0)                                              10542751
PACK2    PACK  0(8,0),0(15,0)                                           10542752
ERRO1    LA    7,ER17                                                   10542753
         BAL   14,CVD                                                   10542754
         UNPK  ER17(3),OUTARA(8)                                        10542755
         BALR  14,8                    GO TO ERROR ROUTINE              10542756
         BC    15,L                                                     10542757
ERRO     LA    7,ER15                                                   10542758
         BAL   14,CVD                                                   10542759
         UNPK  ER15(3),OUTARA(8)                                        10542760
         BALR  14,8                    GO TO ERROR ROUTINE              10542761
         BC    15,L                                                     10542762
XTEN     DC    X'A000'                                                  10542763
XSIX     DC    X'6000'                                                  10542764
ZERO     DC    H'0'                                                     10542765
ONE      DC    X'0001'                                                  10542766
TWO      DC    H'2'                                                     10542767
THREE    DC    H'3'                                                     10542768
SIX      DC    H'6'                                                     10542769
SEVEN    DC    H'7'                                                     10542770
EIGHT    DC    H'8'                                                     10542771
TWELVE   DC    H'12'                                                    10542772
FORTEN   DC    H'14'                                                    10542773
SIXTEN   DC    H'16'                                                    10542774
ATEY3    DC    H'83'                                                    10542775
TWO56    DC    H'256'                                                   10542776
FOR096   DC    H'4096'                                                  10542777
ATEK     DC    H'8192'                                                  10542778
SWIT     DC    X'0000'                                                  10542779
KONST    DC    X'EF00'                                                  10542780
MAXIO    DC    H'0'                                                     10542781
UIN      DC    C'UIN '                                                  10542782
         DC    X'20'                                                    10542783
ER00     DC    C'TAPE TO TAPE UTI'                                      10542784
         DC    C'LITY            '                                      10542785
         DC    F'0'                                                     10542786
         DC    X'11'                                                    10542787
ER0      DC    C'INCORRECT PROGRA'                                      10542788
         DC    C'M'                                                     10542789
         DC    X'16'                                                    10542790
ER1      DC    C'INCORRECT INPUT '                                      10542791
         DC    C'DEVICE'                                                10542792
         DC    X'17'                                                    10542793
ER2      DC    C'INCORRECT OUTPUT'                                      10542794
         DC    C' DEVICE'                                               10542795
         DC    X'1E'                                                    10542796
ER3      DC    C'B ILLEGAL FORMAT'                                      10542797
         DC    C' UTIL MOD CARD'                                        10542798
         DC    X'23'                                                    10542799
ER5      DC    C'FIXED LENGTH REC'                                      10542800
         DC    C'ORD FORMAT REQUI'                                      10542801
         DC    C'RED'                                                   10542802
         DC    X'1C'                                                    10542803
ER6      DC    C'INVALID JOB FOR '                                      10542804
         DC    C'THIS PROGRAM'                                          10542805
         DC    X'1B'                                                    10542806
ER7      DC    C'INVALID INPUT RE'                                      10542807
         DC    C'CORD LENGTH'                                           10542808
         DC    X'1A'                                                    10542809
ER8      DC    C'INVALID INPUT BL'                                      10542810
         DC    C'OCK LENGTH'                                            10542811
         DC    X'1C'                                                    10542812
ER9      DC    C'INVALID OUTPUT R'                                      10542813
         DC    C'ECORD LENGTH'                                          10542814
         DC    X'1B'                                                    10542815
ER10     DC    C'INVALID OUTPUT B'                                      10542816
         DC    C'LOCK LENGTH'                                           10542817
         DC    X'14'                                                    10542818
ER11     DC    C'INVALID INPUT OP'                                      10542819
         DC    C'TION'                                                  10542820
         DC    X'15'                                                    10542821
ER12     DC    C'INVALID OUTPUT O'                                      10542822
         DC    C'PTION'                                                 10542823
         DC    X'1B'                                                    10542824
ER14     DC    C'I/O AREA CANNOT '                                      10542825
         DC    C'BE ASSIGNED'                                           10542826
         DC    X'20'                                                    10542827
ER15     DC    C'    INVALID UNPA'                                      10542828
         DC    C'CK OUTPUT LENGTH'                                      10542829
         DC    X'24'                                                    10542830
ER16     DC    C'    RECORD CAPAC'                                      10542831
         DC    C'ITY EXCEEDED BY '                                      10542832
         DC    C'    '                                                  10542833
         DC    X'1E'                                                    10542834
ER17     DC    C'    INVALID PACK'                                      10542835
         DC    C' OUTPUT LENGTH'                                        10542836
         DC    X'18'                                                    10542837
ER18     DC    C'INPUT RECORD LEN'                                      10542838
         DC    C'GTH     '                                              10542839
         DC    X'16'                                                    10542840
ER19     DC    C'INPUT BLOCK SIZE'                                      10542841
         DC    C'      '                                                10542842
         DC    X'1A'                                                    10542843
ER20     DC    C'OUTPUT RECORD LE'                                      10542844
         DC    C'NGTH      '                                            10542845
         DC    X'17'                                                    10542846
ER21     DC    C'OUTPUT BLOCK SIZ'                                      10542847
         DC    C'E      '                                               10542848
         DC    X'20'                                                    10542849
ER22     DC    C'INPUT OPTION    '                                      10542850
         DC    C'                '                                      10542851
         DC    X'20'                                                    10542852
ER23     DC    C'OUTPUT OPTION   '                                      10542853
         DC    C'                '                                      10542854
         DC    X'1F'                                                    10542855
ER24     DC    C'  INPUT,  OUTPUT'                                      10542856
         DC    C' AREAS ASSIGNED'                                       10542857
         DC    X'20'                                                    10542858
ER25     DC    C'   INPUT / OUTPU'                                      10542859
         DC    C'T AREAS ASSIGNED'                                      10542860
         DC    X'1E'                                                    10542861
ER26     DC    C'FIELD SELECT MUS'                                      10542862
         DC    C'T BE SPECIFIED'                                        10542863
         DC    X'21'                                                    10542864
ER31     DC    C'         INPUT L'                                      10542865
         DC    C'ENGTH EQUALS ZER'                                      10542866
         DC    C'O'                                                     10542867
         DC    X'17'                                                    10542868
ER32     DC    C'RECORD FORMAT   '                                      10542869
         DC    C'       '                                               10542870
         DC    X'1D'                                                    10542871
ER33     DC    C'TYPE            '                                      10542872
         DC    C'             '                                         10542873
ER39A    DC    C'COPY'                                                  10542874
ER39B    DC    C'FIELD SELECT'                                          10542875
ER39C    DC    C'REBLOCK'                                               10542876
ER39D    DC    C'REBLOCK, FIELD S'                                      10542877
         DC    C'ELECT'                                                 10542878
ER40     DC    C'UNDEFINED'                                             10542879
ER41     DC    C'VARIABLE '                                             10542880
ER42     DC    C'FIXED    '                                             10542881
ER43     DC    C'FS  '                                                  10542882
ER44     DC    C'UNPK'                                                  10542883
ER45     DC    C'PACK'                                                  10542884
ER45A    DC    C'TAPE MULTIPLE   '                                      10542885
ER46     DC    C'NO REWIND,UNLOAD'                                      10542886
ER49     DC    C'TAPE REWIND'                                           10542887
ER50     DC    C'TAPE REWIND,UNLO'                                      10542888
         DC    C'AD'                                                    10542889
         DC    X'21'                                                    10542890
ERWR     DC    C'    CAN NOT PROC'                                      10542891
         DC    C'ESS HEX PARAMETE'                                      10542892
         DC    C'R'                                                     10542893
         ORG   STAR+3826                                                10542894
NOFS     DS    H                                                        10542895
         END   START                                                    10542896
         TITLE 'PHASE 3&4 TAPE TO TAPE'                                 10542897
         START 2752                                                     10542898
STRT     BALR  15,0                                                     10542899
         USING *,15                                                     10542900
         BC    15,INI3                                                  10542901
SORS     EQU   2500                                                     10542902
QORS     EQU   2504                                                     10542903
IRCLN    EQU   2508                                                     10542904
IBKSZ    EQU   2510                                                     10542905
ORCLN    EQU   2512                                                     10542906
OBKSZ    EQU   2514                                                     10542907
TPGM     EQU   2516                                                     10542908
TJOB     EQU   2517                                                     10542909
FRCD     EQU   2518                                                     10542910
DOPTN    EQU   2519                                                     10542911
POPTN    EQU   2520                                                     10542912
LABSW    EQU   2521                                                     10542913
ICU      EQU   2522                                                     10542914
OCU      EQU   2523                                                     10542915
IBKC     EQU   2524                                                     10542916
OBKC     EQU   2528                                                     10542917
LABIH    EQU   2532                                                     10542918
LABOH    EQU   2534                                                     10542919
LABIT    EQU   2536                                                     10542920
LABOT    EQU   2538                                                     10542921
LABOR    EQU   2540                                                     10542922
AAST     EQU   2542                                                     10542923
LABRTN   EQU   2544                                                     10542924
IPA      EQU   2546                                                     10542925
OPA      EQU   2548                                                     10542926
INA      EQU   2550                                                     10542927
INB      EQU   2552                                                     10542928
OUTA     EQU   2554                                                     10542929
OUTB     EQU   2556                                                     10542930
UCLIM    EQU   2558                                                     10542931
SWHD     EQU   2560                                                     10542932
NOIO     EQU   2561                                                     10542933
HEAD     EQU   2562                                                     10542934
DSTBL    EQU   2706                                                     10542935
*                                                                       10542936
****  ** PHASE IV,  TAPE TO TAPE PROGRAM **                             10542937
*                                                                       10542938
***   INPUT OPERATION                                                   10542939
*                                                                       10542940
         LA    15,2754                                                  10542941
         LM    1,10,REG                                                 10542942
OPEN     LA    7,P3IH+2                                                 10542943
         STH   7,LABRTN                                                 10542944
         STM   1,10,REG                                                 10542945
         LH    7,LABIH                                                  10542946
P3IH     BCR   15,7           BRANCH TO OPEN INPUT FILE                 10542947
         LM    1,10,REG                                                 10542948
         BC    15,OOPEN                                                 10542949
         LA    7,PH3IH+2                                                10542950
         STH   7,LABIH                                                  10542951
OOPEN    LA    7,P3OHR                                                  10542952
         STH   7,LABRTN                                                 10542953
         STM   1,10,REG                                                 10542954
         LH    7,LABOH                                                  10542955
P3OH     BCR   15,7           BRANCH TO OPEN OUTPUT FILE                10542956
         MVI   CCWOA,X'1F'    WRITE TAPE MARK                           10542957
         SVC   0                                                        10542958
         DC    YL2(CCBOA)                                               10542959
         TM    CCBOA+2,X'80'                                            10542960
         BC    8,*-4                                                    10542961
         MVI   CCWOA,X'01'                                              10542962
P3OHR    LM    1,10,REG                                                 10542963
         BC    15,AAA                                                   10542964
         LA    7,PH3OH+2                                                10542965
         STH   7,LABOH                                                  10542966
AAA      LH    7,OBKSZ        CLEAR OUTPUT AREA                         10542967
         LH    11,OUTA                                                  10542968
         LH    14,OUTB                                                  10542969
         AH    11,OBKSZ                                                 10542970
         AH    14,OBKSZ                                                 10542971
         BCTR  11,0                                                     10542972
         BCTR  14,0                                                     10542973
         MVI   0(11),X'40'                                              10542974
         MVI   0(14),X'40'                                              10542975
         BCT   7,*-12                                                   10542976
ISVC     DC    X'4700'                                                  10542977
         DC    YL2(CCBIA)                                               10542978
AA3      BC    0,AG3          IS INPUT AREA EXHAUSTED                   10542979
AB3      BC    0,AB2          IS 1-INPUT AREA                           10542980
         TM    2(1),X'80'     WAIT INPUT                                10542981
         BC    8,*-4                                                    10542982
RTNI1    LH    7,IAREA                                                  10542983
         CLC   CHKPT(12),0(7) IS CHECK POINT                            10542984
         BC    8,TST4         YES, BRANCH TO TST4                       10542985
CH4      BC    0,CPT4+4                                                 10542986
         TM    3(1),X'04'     IS INPUT END OF FILE                      10542987
         BC    7,IEOV                                                   10542988
         NI    IEOV+1,X'0F'                                             10542989
         L     7,IBKC         COUNT THE NUMBER OF BLOCKS                10542990
         LA    7,1(7)                                                   10542991
         ST    7,IBKC                                                   10542992
         TM    2(1),X'40'     IS INCORRECT LENGTH                       10542993
         BC    8,AD4          NO                                        10542994
         MVC   RSCNT(2),0(1)  YES                                       10542995
         LA    11,RRLMG+35                                              10542996
         L     7,IBKC                                                   10542997
         CVD   7,DRCNO                                                  10542998
         OI    DRCNO+7,X'0F'                                            10542999
         UNPK  0(7,11),DRCNO(8)                                         10543000
         CLI   0(11),X'F0'                                              10543001
         BC    7,*+16                                                   10543002
         MVI   0(11),X'F0'                                              10543003
         LA    11,1(11)                                                 10543004
         BC    15,*-16                                                  10543005
         SVC   0              LOG MESSAGE                               10543006
         DC    YL2(CCBER)                                               10543007
         TM    CCBER+2,X'80'                                            10543008
         BC    8,*-4                                                    10543009
         OI    WRGBC+1,X'F0'                                            10543010
AD4      BC    15,CHGIM       CHANG INPUT LIST                          10543011
         MVC   ITAREA(2),INB                                            10543012
         MVC   IAREA(2),INA                                             10543013
         LA    1,CCBIA                                                  10543014
         STH   1,CHGI1                                                  10543015
         LH    6,INB                                                    10543016
         LR    5,6                                                      10543017
         AH    5,IBKSZ                                                  10543018
         BCTR  5,0                                                      10543019
         BC    15,CHGIX                                                 10543020
CHGIM    MVC   ITAREA(2),INA                                            10543021
         MVC   IAREA(2),INB                                             10543022
         LA    1,CCBIB                                                  10543023
         STH   1,CHGI1                                                  10543024
         LH    6,INA                                                    10543025
         LR    5,6                                                      10543026
         AH    5,IBKSZ                                                  10543027
         BCTR  5,0                                                      10543028
CHGIX    XI    AD4+1,X'F0'                                              10543029
WRGBC    BC    0,WRG                                                    10543030
         SVC   0              EXECUTE INPUT                             10543031
CHGI1    DC    YL2(CCBIB)                                               10543032
         BC    15,AG3                                                   10543033
CPT4     STH   1,*+6          SKIP READING                              10543034
         SVC   0                                                        10543035
         DS    H                                                        10543036
         BC    15,AB3+4                                                 10543037
TST4     TM    CH4+1,X'F0'    IS FIRT CHKPT RECORD                      10543038
         BC    8,CPFT4        YES, BRANCH TO CPFT4                      10543039
         NI    CH4+1,X'0F'    SET BRANCH INSTRUCTION                    10543040
         BC    15,CPT4+4                                                10543041
CPFT4    OI    CH4+1,X'F0'    SET BRANCH INSTRUCTION                    10543042
         BC    15,CPT4                                                  10543043
WRG      SH    5,RSCNT                                                  10543044
         NI    WRGBC+1,X'0F'                                            10543045
         BC    15,WRGBC+4                                               10543046
TST2     TM    CH2+1,X'F0'    IS FIRST TIME                             10543047
         BC    8,CPFT2        YES, BRANCH TO CPFT2                      10543048
         NI    CH2+1,X'0F'    SET BRANCH INSTRUCTION                    10543049
         BC    15,AD1-4                                                 10543050
CPFT2    OI    CH2+1,X'F0'    SET BRANCH INSTRUCYION                    10543051
         BC    15,AD1-4                                                 10543052
MCC2     LH    7,CCWOA+6      MODIFY COUNT                              10543053
         SH    7,RSCNT                                                  10543054
         STH   7,CCWOA+6                                                10543055
         STH   7,CCWOB+6                                                10543056
         BC    15,AF1                                                   10543057
AC2      NI    AB2+1,X'0F'                                              10543058
         BC    15,AD1                                                   10543059
AB2      BC    0,AC2                                                    10543060
         STH   1,*+6                                                    10543061
         SVC   0              EXECUTE INPUT                             10543062
         DC    YL2(CCBIA)                                               10543063
AD1      TM    2(1),X'80'     WAIT INPUT                                10543064
         BC    8,*-4                                                    10543065
RTNI2    LH    7,IAREA        IS CHECK POINT RECOR                      10543066
         CLC   CHKPT(12),0(7)                                           10543067
         BC    8,TST2         YES, BRANCH TO TST2                       10543068
CH2      BC    0,AD1-4                                                  10543069
         TM    3(1),X'04'     IS INPUT END OF FILE                      10543070
         BC    7,IEOV                                                   10543071
         NI    IEOV+1,X'0F'                                             10543072
         L     7,IBKC         COUNT THE NUMBER OF BLOCKS                10543073
         LA    7,1(7)                                                   10543074
         ST    7,IBKC                                                   10543075
         LH    6,INA                                                    10543076
         LR    5,6                                                      10543077
         AH    5,IBKSZ                                                  10543078
         BCTR  5,0                                                      10543079
         TM    2(1),X'40'     IS INCORRECT LENGTH                       10543080
         BC    8,AF1          NO                                        10543081
         MVC   RSCNT(2),0(1)  YES                                       10543082
         TM    FRCD,X'01'     IS FIXED RECORD                           10543083
         BC    8,MCC2         NO, BRANCH TO MCC                         10543084
         LA    11,RRLMG+35                                              10543085
         L     7,IBKC                                                   10543086
         CVD   7,DRCNO                                                  10543087
         OI    DRCNO+7,X'0F'                                            10543088
         UNPK  0(7,11),DRCNO(8)                                         10543089
         CLI   0(11),X'F0'                                              10543090
         BC    7,*+16                                                   10543091
         MVI   0(11),X'F0'                                              10543092
         LA    11,1(11)                                                 10543093
         BC    15,*-16                                                  10543094
         SVC   0              LOG MESSAGE                               10543095
         DC    YL2(CCBER)                                               10543096
         TM    CCBER+2,X'80'                                            10543097
         BC    8,*-4                                                    10543098
         TM    TJOB,X'01'     IS COPY                                   10543099
         BC    1,MCC2                                                   10543100
         SH    5,RSCNT                                                  10543101
AF1      BC    15,CHGM        CHANGE INPUT LIST                         10543102
         MVC   ITAREA(2),INB                                            10543103
         MVC   IAREA(2),INA                                             10543104
         LA    1,CCBIA                                                  10543105
         STH   1,CHGI2                                                  10543106
         BC    15,CHGX                                                  10543107
CHGM     MVC   ITAREA(2),INA                                            10543108
         MVC   IAREA(2),INB                                             10543109
         LA    1,CCBIB                                                  10543110
         STH   1,CHGI2                                                  10543111
CHGX     LH    6,INA                                                    10543112
         XI    AF1+1,X'F0'                                              10543113
*                                                                       10543114
***   MAIN LINE                                                         10543115
*                                                                       10543116
*                                                                       10543117
**    SHIFT ROUTINE                                                     10543118
*                                                                       10543119
SHR      TM    TJOB,X'01'     IS COPY                                   10543120
         BC    1,BA3          YES, BRANCH TO BA3                        10543121
         LA    7,RTN3         NO, BRANCH TO PHASE II                    10543122
         LH    11,UCLIM                                                 10543123
         BCR   15,11                                                    10543124
RTN3     BXLE  6,4,SSICHK     MODIFY INPUT LOGICAL RECORD ADDRESS       10543125
         NI    AA3+1,X'0F'                                              10543126
         NI    BB3+1,X'0F'                                              10543127
         BC    15,SSOCHK                                                10543128
SSICHK   OI    AA3+1,X'F0'                                              10543129
         OI    BB3+1,X'F0'                                              10543130
SSOCHK   BXLE  10,8,*+12      MODIFY OUTPUT LOGICAL RECORD ADDRESS      10543131
         NI    BA3+1,X'0F'                                              10543132
         BC    15,AK3                                                   10543133
         OI    BA3+1,X'F0'                                              10543134
*                                                                       10543135
***   AUXILIARY INPUT OPERATION                                         10543136
*                                                                       10543137
BA3      BC    0,AA3          IS OUTPUT AREA EXHAUSTED                  10543138
BB3      BC    0,BD3          IS INPUT AREA EXHAUSTED                   10543139
BB2      BC    0,BD3          IS 1-INPUT AREA                           10543140
         SVC   0              EXECUTE INPUT                             10543141
CHGI2    DC    YL2(CCBIB)                                               10543142
         OI    AB2+1,X'F0'                                              10543143
*                                                                       10543144
***   OUTPUT OPERATION                                                  10543145
*                                                                       10543146
BD3      BC    0,BD2          IS 1-OUTPUT AREA                          10543147
         BC    15,BH4                                                   10543148
         TM    2(2),X'80'     WAIT OUTPUT                               10543149
         BC    8,*-4                                                    10543150
         L     7,OBKC         COUNT THE NUMBER OF BLOCKS                10543151
         LA    7,1(7)                                                   10543152
         ST    7,OBKC                                                   10543153
         TM    3(2),X'04'     IS OUTPUT END OF FILE                     10543154
         BC    7,OEOV                                                   10543155
BF4      BC    15,CHGOM       CHANG OUTPUT LIST                         10543156
         MVC   OTAREA(2),OUTA                                           10543157
         LA    2,CCBOB                                                  10543158
         STH   2,CHGO1                                                  10543159
         LH    10,OUTA                                                  10543160
         BC    15,CHGOX                                                 10543161
CHGOM    MVC   OTAREA(2),OUTB                                           10543162
         LA    2,CCBOA                                                  10543163
         STH   2,CHGO1                                                  10543164
         LH    10,OUTB                                                  10543165
CHGOX    XI    BF4+1,X'F0'                                              10543166
         LR    9,10                                                     10543167
         AH    9,OBKSZ                                                  10543168
         BCTR  9,0                                                      10543169
         SVC   0              EXECUTE OUTPUT                            10543170
CHGO1    DC    YL2(CCBOA)                                               10543171
         BC    15,AA3                                                   10543172
BH4      NI    BD3+5,X'0F'                                              10543173
         BC    15,BF4                                                   10543174
BD2      SVC   0              EXECUTE OUTPUT                            10543175
CHGO2    DC    YL2(CCBOA)                                               10543176
         TM    2(2),X'80'     WAIT OUTPUT                               10543177
         BC    8,*-4                                                    10543178
         LH    7,OBKSZ                                                  10543179
         STH   7,CCWOA+6                                                10543180
         STH   7,CCWOB+6                                                10543181
         L     7,OBKC         COUNT THE NUMBER OF BLOCKS                10543182
         LA    7,1(7)                                                   10543183
         ST    7,OBKC                                                   10543184
         TM    3(2),X'04'     IS OUTPUT END OF FILE                     10543185
         BC    7,OEOV                                                   10543186
BG2      BC    15,CHGMO       CHANGE OUTPUT LIST                        10543187
         MVC   OTAREA(2),OUTA                                           10543188
         LA    2,CCBOA                                                  10543189
         STH   2,CHGO2                                                  10543190
         BC    15,CHGXO                                                 10543191
CHGMO    MVC   OTAREA(2),OUTB                                           10543192
         LA    2,CCBOB                                                  10543193
         STH   2,CHGO2                                                  10543194
CHGXO    XI    BG2+1,X'F0'                                              10543195
         LH    10,OUTA                                                  10543196
         BC    15,AA3                                                   10543197
*                                                                       10543198
***   TAPE OUTPUT END OF REEL ROUTINE                                   10543199
*                                                                       10543200
OEOV     MVI   CCWOA,X'1F'    WRITE TAPE MARK                           10543201
         SVC   0                                                        10543202
         DC    YL2(CCBOA)                                               10543203
         TM    CCBOA+2,X'80'                                            10543204
         BC    8,*-4                                                    10543205
         MVI   CCWOA,X'01'                                              10543206
         LA    7,P3OR+2       SET LINKAGE                               10543207
         STH   7,LABRTN                                                 10543208
         STM   1,10,REG                                                 10543209
         LH    7,LABOR                                                  10543210
P3OR     BCR   15,7           BRANCH TO OUTPUT END OF REEL              10543211
         LM    1,10,REG                                                 10543212
OOTP     TM    DOPTN,X'09'    IS UNLOAD OPTION                          10543213
         BC    8,OERW         NO, BRANCH TO OERW                        10543214
         MVI   CCWOA,X'0F'    UNLOAD TAPE                               10543215
         SVC   0                                                        10543216
         DC    YL2(CCBOA)                                               10543217
         TM    CCBOA+2,X'80'                                            10543218
         BC    8,*-4                                                    10543219
         MVI   CCWOA,X'01'                                              10543220
OERW     TM    DOPTN,X'04'    IS REWIND OPTION                          10543221
         BC    8,OENT         NO, BRANCH TO OENT                        10543222
         MVI   CCWOA,X'07'    REWIND TAPE                               10543223
         SVC   0                                                        10543224
         DC    YL2(CCBOA)                                               10543225
         TM    CCBOA+2,X'80'                                            10543226
         BC    8,*-4                                                    10543227
OENT     BC    0,ELOG         IS EOF                                    10543228
         TM    DOPTN,X'09'                                              10543229
         BC    7,*+24                                                   10543230
         MVI   CCWOA,X'0F'                                              10543231
         SVC   0                                                        10543232
         DC    YL2(CCBOA)                                               10543233
         TM    CCBOA+2,X'80'                                            10543234
         BC    8,*-4                                                    10543235
         MVI   CCWOA,X'01'                                              10543236
         SR    7,7            LOG END OF REEL FOR OUTPUT                10543237
         IC    7,OCU                                                    10543238
         AH    7,22                                                     10543239
         MVO   FMVO(2),0(2,7)                                           10543240
         UNPK  EORMG+18(3),FMVO(2)                                      10543241
         SVC   0                                                        10543242
         DC    YL2(CCBEOR)                                              10543243
         TM    CCBEOR+2,X'80'                                           10543244
         BC    8,*-4                                                    10543245
FLBCO    BC    15,*+12        NO, SET CURRENT UNIT                      10543246
         IC    7,OPA                                                    10543247
         BC    15,*+8                                                   10543248
         IC    7,OPA+1                                                  10543249
         STC   7,OCU                                                    10543250
         STC   7,CCBOA+5                                                10543251
         STC   7,CCBOB+5                                                10543252
         XI    FLBCO+1,X'F0'                                            10543253
         LA    7,PH3OHR       SET LINKAGE                               10543254
         STH   7,LABRTN                                                 10543255
         STM   1,10,REG                                                 10543256
         LH    7,LABOH                                                  10543257
PH3OH    BCR   15,7           BRANCH TO OPEN OUTPUT FILE                10543258
         MVI   CCWOA,X'1F'                                              10543259
         SVC   0                                                        10543260
         DC    YL2(CCBOA)                                               10543261
         TM    CCBOA+2,X'80'                                            10543262
         BC    8,*-4                                                    10543263
         MVI   CCWOA,X'01'                                              10543264
PH3OHR   LM    1,10,REG                                                 10543265
         XC    OBKC(4),OBKC                                             10543266
         TM    BD3+1,X'F0'    IS 1-OUTPUT AREA                          10543267
         BC    8,BF4                                                    10543268
         BC    15,BG2                                                   10543269
*                                                                       10543270
***   TAPE INPUT END OF FILE ROUTINE                                    10543271
*                                                                       10543272
IEOV     BC    15,ISVC                                                  10543273
         LA    7,P3IT+2                                                 10543274
         STH   7,LABRTN                                                 10543275
         STM   1,10,REG                                                 10543276
         LH    7,LABIT                                                  10543277
P3IT     BCR   15,7           BRANCH TO INPUT TRAILOR LABEL             10543278
         LM    1,10,REG                                                 10543279
         TM    DOPTN,X'90'    IS UNLOAD OPTION                          10543280
         BC    8,IERW         NO, BRANCH TO IERW                        10543281
         MVI   CCWIA,X'0F'    UNLOAD TAPE                               10543282
         SVC   0                                                        10543283
         DC    YL2(CCBIA)                                               10543284
         TM    CCBIA+2,X'80'                                            10543285
         BC    8,*-4                                                    10543286
         MVI   CCWIA,X'02'                                              10543287
IERW     TM    DOPTN,X'40'    IS REWIND OPTION                          10543288
         BC    8,IEPS         NO, BRANCH TO IEPS                        10543289
         MVI   CCWIA,X'07'    REWIND TAPE                               10543290
         SVC   0                                                        10543291
         DC    YL2(CCBIA)                                               10543292
         TM    CCBIA+2,X'80'                                            10543293
         BC    8,*-4                                                    10543294
         MVI   CCWIA,X'02'                                              10543295
IEPS     TM    LABSW,X'10'    IS EOV OR EOF DEFINED                     10543296
         BC    7,TEOF         YES, BRANCH TO TEOF                       10543297
ANSWR    SVC   2              WAIT FOR OPERATOR S ANSWER                10543298
         DC    CL6'3ANSA '                                              10543299
         CLI   ANSWR+7,C'Y'   IS EOF                                    10543300
         BC    8,B3           YES, BRANCH TO B3                         10543301
         CLI   ANSWR+7,C'N'   IS EOV                                    10543302
         BC    7,ANSWR        NO, WAIT IT AGAIN                         10543303
         NI    LABSW,X'7F'    YES, SET LABSW                            10543304
TEOF     TM    LABSW,X'80'    IS EOF                                    10543305
         BC    1,B3           YES, BRANCH TO B3                         10543306
         SR    7,7            LOG END OF REEL FOR INPUT                 10543307
         IC    7,ICU                                                    10543308
         AH    7,22                                                     10543309
         MVO   FMVO(2),0(2,7)                                           10543310
         UNPK  EORMG+18(3),FMVO(2)                                      10543311
         SVC   0                                                        10543312
         DC    YL2(CCBEOR)                                              10543313
         TM    CCBEOR+2,X'80'                                           10543314
         BC    8,*-4                                                    10543315
FLBCI    BC    15,*+12        SET CURRENT UNIT                          10543316
         IC    7,IPA                                                    10543317
         BC    15,*+8                                                   10543318
         IC    7,IPA+1                                                  10543319
         STC   7,ICU                                                    10543320
         STC   7,CCBIA+5                                                10543321
         STC   7,CCBIB+5                                                10543322
         XI    FLBCI+1,X'F0'                                            10543323
         LA    7,PH3IH+2      SET LINKAGE                               10543324
         STH   7,LABRTN                                                 10543325
         STM   1,10,REG                                                 10543326
         LH    7,LABIH                                                  10543327
PH3IH    BCR   15,7           BRANCH TO OPEN INPUT FILE                 10543328
         LM    1,10,REG                                                 10543329
         XC    IBKC(4),IBKC                                             10543330
         MVC   IEOV(4),EXIBC                                            10543331
EXI      STH   1,*+6                                                    10543332
         SVC   0              EXECUTE INPUT                             10543333
         DS    H                                                        10543334
         TM    2(1),X'80'                                               10543335
         BC    8,*-4                                                    10543336
         TM    AB3+1,X'F0'    IS 1-INPUT AREA                           10543337
         BC    1,RTNI2        YES, BRANCH TO RTNI2                      10543338
         BC    15,RTNI1       NO, BRANCH TO RTNI1                       10543339
EXIBC    BC    15,EXI                                                   10543340
B3       TM    BA3+1,X'F0'    IS OUTPUT AREA EXHAUSTED                  10543341
         BC    8,IEMG         YES, BRANCH TO IEMG                       10543342
         SH    10,OTAREA                                                10543343
         STH   10,CCWOA+6     STORE COUNT AT COMMAND WORDS              10543344
         STH   10,CCWOB+6                                               10543345
         LA    3,IEWT         GENERATE LINKAGE TO OUTPUT OPERATION      10543346
         LH    7,BCR                                                    10543347
         STH   7,CHGO1+2                                                10543348
         STH   7,CHGO2+2                                                10543349
         BC    15,BD3                                                   10543350
BCR      BCR   15,3                                                     10543351
IEWT     TM    2(2),X'80'     WAIT OUTPUT                               10543352
         BC    8,*-4                                                    10543353
IEMG     MVI   CCWOA,X'1F'    WRITE TAPE MARK                           10543354
         SVC   0                                                        10543355
         DC    YL2(CCBOA)                                               10543356
         TM    CCBOA+2,X'80'                                            10543357
         BC    8,*-4                                                    10543358
         MVI   CCWOA,X'01'                                              10543359
         TM    BD3+1,X'F0'    IS 1-OUTPUT AREA                          10543360
         BC    7,*+16         YES, SKIP                                 10543361
         L     7,OBKC         NO, MODIFY COUNT OF BLOCKS                10543362
         LA    7,1(7)                                                   10543363
         ST    7,OBKC                                                   10543364
         LA    7,P3OT+2       SET LINKAGE                               10543365
         STH   7,LABRTN                                                 10543366
         STM   1,10,REG                                                 10543367
         LH    7,LABOT                                                  10543368
P3OT     BCR   15,7           BRANCH TO CLOSE OUTPUT FILE               10543369
         LM    1,10,REG                                                 10543370
         OI    OENT+1,X'F0'                                             10543371
         BC    15,OOTP                                                  10543372
ELOG     SVC   0              LOG MESSAGE                               10543373
         DC    YL2(CCBLG1)                                              10543374
         TM    CCBLG1+2,X'80' WAIT TYPING                               10543375
         BC    8,*-4                                                    10543376
         SVC   1              TERMINATE JOB                             10543377
         DC    CL6'SYSEOJ'                                              10543378
*                                                                       10543379
***   CONSTANT                                                          10543380
*                                                                       10543381
AG3      EQU   SHR                                                      10543382
AK3      EQU   BA3                                                      10543383
         CNOP  0,8                                                      10543384
DRCNO    DS    D                                                        10543385
REG      DS    CL40                                                     10543386
CCBIA    DC    X'00000000'                                              10543387
         DC    X'000C'                                                  10543388
         DC    YL2(CCWIA)                                               10543389
CCBIB    DC    X'00000000'                                              10543390
         DC    X'000C'                                                  10543391
         DC    YL2(CCWIB)                                               10543392
CCBOA    DC    X'00000000'                                              10543393
         DC    X'0010'                                                  10543394
         DC    YL2(CCWOA)                                               10543395
CCBOB    DC    X'00000000'                                              10543396
         DC    X'0010'                                                  10543397
         DC    YL2(CCWOB)                                               10543398
CCBLG1   DC    X'00000000'                                              10543399
         DC    X'0014'                                                  10543400
         DC    YL2(CCWLG1)                                              10543401
CCBER    DC    X'00000000'                                              10543402
         DC    X'0014'                                                  10543403
         DC    YL2(CCWER)                                               10543404
CCBEOR   DC    X'000000000014'                                          10543405
         DC    YL2(CCWEOR)                                              10543406
CCWIA    DC    X'0200000000000000'                                      10543407
CCWIB    DC    X'0200000000000000'                                      10543408
CCWOA    DC    X'0100000000000000'                                      10543409
CCWOB    DC    X'0100000000000000'                                      10543410
CCWLG1   DC    X'09'                                                    10543411
         DC    AL3(TMMG)                                                10543412
         DC    X'0000000B'                                              10543413
CCWER    DC    X'09'                                                    10543414
         DC    AL3(RRLMG)                                               10543415
         DC    X'0000002A'                                              10543416
CCWEOR   DC    X'09'                                                    10543417
         DC    AL3(EORMG)                                               10543418
         DC    X'00000015'                                              10543419
ITAREA   DS    H                                                        10543420
OTAREA   DS    H                                                        10543421
IAREA    DS    H                                                        10543422
RSCNT    DS    H                                                        10543423
FMVO     DC    X'000F'                                                  10543424
TMMG     DC    C' END OF JOB'                                           10543425
RRLMG    DC    C' INCORRECT BLOCK'                                      10543426
         DC    C' LENGTH AT BLK. '                                      10543427
         DC    C'NO.       '                                            10543428
EORMG    DC    C' END OF TAPE REE'                                      10543429
         DC    C'L    '                                                 10543430
CHKPT    DC    C'/// CHKPT //'                                          10543431
LAST     DS    H                                                        10543432
         ORG   LAST+150                                                 10543433
LAB2     MVC   CCB+5(1),LOCU            GET OUTPUT CURRENT UNIT         10543434
       LH    14,22                                                      10543435
       AH    14,CCB+4                                                   10543436
       MVI   CCW7,X'3F'                                                 10543437
       OC    CCW7(1),3(14)                                              10543438
       XI    CCW7,X'14'                                                 10543439
         L     9,SAVE9                  LOAD VOL SEQ NO IN REG 9        10543440
REW1     MVI   CCW,X'07'                                                10543441
         BAL   14,IOPER                 REWIND TAPE                     10543442
         MVI   CCW,X'02'                                                10543443
         BAL   14,IOPER                 READ TAPE                       10543444
         CLC   LABEL(4),VOL1                                            10543445
         BC    7,REW2                   BRANCH UNEQUAL                  10543446
         TM    SW1,X'FF'                1ST REEL                        10543447
         BC    1,READ1                  BRANCH IF ON  NO 1ST REEL       10543448
         LH    1,LAAST                  MATCH VOL SER NO T/C  GET CARD  10543449
         CLC   1(4,1),UOUT                                              10543450
         BC    8,NUEVO1                                                 10543451
         TM    LABSW,X'40'                                              10543452
         BC    1,ABORT                                                  10543453
         LA    1,83(1)                                                  10543454
         CLC   1(4,1),UOUT                                              10543455
         BC    7,ABORT                                                  10543456
NUEVO1   STH   1,LAASTO                                                 10543457
         CLC   25(6,1),LABEL+4                                          10543458
         BC    7,ENTER                                                  10543459
READ1    MVI   CCW,X'02'                                                10543460
         BAL   14,IOPER                 READ VOL                        10543461
         CLC   LABEL(3),VOL1                                            10543462
         BC    8,READ1                                                  10543463
         CLC   LABEL(4),HDR1            MATCH HDR1                      10543464
         BC    7,MES1                                                   10543465
         LH    2,20                                                     10543466
         CLC   LABEL+48(5),4(2)         MATCH  EXP. DATE                10543467
         BC    2,MES2                                                   10543468
BS1      MVI   CCW,X'27'                BACKSPACE TAPE                  10543469
         BAL   14,IOPER                                                 10543470
         MVC   LABEL(4),HDR1                                            10543471
         TM    SW1,X'FF'                                                10543472
         BC    1,ADD                    BRANCH IF ON NO 1ST REEL        10543473
         MVI   SW1,X'FF'                SET ON SW1                      10543474
         PACK  FILPAC(8),31(4,1)                                        10543475
         CVB   9,FILPAC                                                 10543476
MOVECT   MVC   LABEL+4(76),8(1)                                         10543477
A5       MVI   CCW,X'01'                                                10543478
         BAL   14,IOPER                 WRITE TAPE  LABEL               10543479
         TM    USW,X'20'                                                10543480
         BC    1,BN1                                                    10543481
NEW      MVI   CCW,X'1F'                                                10543482
         BAL   14,IOPER                 WRITE TAPE MARK                 10543483
         ST    9,SAVE9                  SAVE VOL SEQ NO                 10543484
         OI    USW,X'20'                       SET ON 3 BIT             10543485
         LH    5,LLABRT                 GET ADDRESS RETURN              10543486
         BCR   15,5                     BRANCH TO PH 4                  10543487
BN1      LA    14,A5                                                    10543488
         STH   14,URET                                                  10543489
         LH    14,ULAB3                                                 10543490
         BCR   15,14                                                    10543491
REW2     MVI   CCW,X'0F'                                                10543492
         BAL   14,IOPER                 REWIND UNLOAD                   10543493
         SVC   2                                                        10543494
       DC    C'3OSLA '                                                  10543495
         BC    15,REW1                                                  10543496
MES1     SVC   2                                                        10543497
       DC    C'3OHDA '                                                  10543498
         CLI   MES1+7,C'R'                                              10543499
         BC    8,REW1                                                   10543500
         BC    15,BS1                                                   10543501
MES2     SVC   2                                                        10543502
       DC    C'3OEDA '                                                  10543503
         CLI   MES2+7,C'R'                                              10543504
         BC    8,REW1                                                   10543505
         BC    15,BS1                                                   10543506
ADD      LA    9,1(9)                                                   10543507
         CVD   9,FILPAC                                                 10543508
         OI    FILPAC+7,X'0F'                                           10543509
         LH    1,LAASTO                                                 10543510
         UNPK  31(4,1),FILPAC                                           10543511
         BC    15,MOVECT                                                10543512
ENTER    SVC   2                                                        10543513
       DC    C'3OVSA '                                                  10543514
         CLI   ENTER+7,C'R'                                             10543515
         BC    8,REW1                                                   10543516
         MVC   25(6,1),LABEL+4                                          10543517
         BC    15,READ1                                                 10543518
IOPER    SVC   0                                                        10543519
         DC    YL2(CCB)                                                 10543520
         TM    CCB+2,X'80'                                              10543521
         BC    8,*-4                                                    10543522
         BCR   15,14                                                    10543523
ABORT  SVC   2                                                          10543524
       DC    C'3LCM  '                                                  10543525
       SVC   1                                                          10543526
         DC    C'SYSEOJ'                                                10543527
         CNOP  0,8                                                      10543528
CCB      DC    F'0'                                                     10543529
         DC    X'0000'                                                  10543530
       DC    YL2(CCW7)                                                  10543531
CCW7   CCW   X'3F',LABEL,X'40',01                                       10543532
CCW      DC    X'00'                                                    10543533
         DC    AL3(LABEL)                                               10543534
         DC    X'0000'                                                  10543535
         DC    X'0050'                                                  10543536
LABEL    DS    20F                                                      10543537
SW1      DC    X'00'                                                    10543538
         CNOP  0,8                                                      10543539
FILPAC   DC    D'0'                                                     10543540
SAVE9    DC    F'0'                                                     10543541
VOL1     DC    C'VOL1'                                                  10543542
HDR1     DC    C'HDR1'                                                  10543543
UOUT     DC    C'UOUT'                                                  10543544
LOCU     EQU   2523                                                     10543545
LOBKC    EQU   2528                                                     10543546
LLABOH   EQU   2534                                                     10543547
LLABOT   EQU   2538                                                     10543548
LLABOR   EQU   2540                                                     10543549
LAAST    EQU   2542                                                     10543550
LLABRT   EQU   2544                                                     10543551
*                                                                       10543552
*                                                                       10543553
*                                                                       10543554
ULAB     EQU   2732                                                     10543555
URET     EQU   2730                                                     10543556
ULAB4    EQU   2728                                                     10543557
ULAB3    EQU   2726                                                     10543558
ULAB2    EQU   2724                                                     10543559
ULAB1    EQU   2722                                                     10543560
USW      EQU   2734                                                     10543561
*                                                                       10543562
*                                                                       10543563
LAB4     MVI   SW2,X'FF'                SET ON SW2                      10543564
         MVC   LABEL(4),EOF1            MOVE EOF1 TO LABEL              10543565
GETCAR   LH    1,LAASTO                                                 10543566
         MVC   LABEL+4(76),8(1)         MOVE CARD TO LABEL              10543567
         L     8,LOBKC                                                  10543568
         CVD   8,FILPAC                                                 10543569
         OI    FILPAC+7,X'0F'                                           10543570
         UNPK  LABEL+54(6),FILPAC                                       10543571
H2       MVC   CCB+5(1),LOCU                                            10543572
         MVI   CCW,X'01'                                                10543573
         BAL   14,IOPER                 WRITE LABEL                     10543574
         TM    USW,X'10'                                                10543575
         BC    1,BN2                                                    10543576
         OI    USW,X'10'                                                10543577
H3       MVI   CCW,X'1F'                                                10543578
         BAL   14,IOPER                 WRITE TAPE MARK                 10543579
         TM    SW2,X'FF'                TEST SW2  FOR EOV OR EOF        10543580
         BC    1,LTM                                                    10543581
EXIT     LH    5,LLABRT                                                 10543582
         BCR   15,5                                                     10543583
LTM      BAL   14,IOPER                 WRITE  LAST  TAPE  MARK         10543584
         BC    15,EXIT                                                  10543585
*                                                                       10543586
BN2      LA    14,H2                                                    10543587
         STH   14,URET                                                  10543588
         LH    14,ULAB4                                                 10543589
         BCR   15,14                                                    10543590
*                                                                       10543591
LAB5     MVC   LABEL(4),EOV1                                            10543592
         BC    15,GETCAR                                                10543593
*                                                                       10543594
*                                                                       10543595
SW2      DC    X'00'                    TO TEST EOV OR EOF              10543596
EOV1     DC    C'EOV1'                                                  10543597
EOF1     DC    C'EOF1'                                                  10543598
LAASTI   DC    H'0'                                                     10543599
LAASTO   DC    H'0'                                                     10543600
LABMAN   DS    20F                                                      10543601
LAB3     MVC   CCBI+5(1),LICU                                           10543602
         MVI   CCWI,X'02'                                               10543603
         BAL   14,PER                                                   10543604
         TM    CCBI+3,X'04'                                             10543605
         BC    1,NN                                                     10543606
         CLC   LABEL(4),EOV1                                            10543607
         BC    8,R1                                                     10543608
         CLC   LABEL(4),EOF1                                            10543609
         BC    8,R2                                                     10543610
NN       TM    SWTIME,X'FF'                                             10543611
         BC    1,BN6                                                    10543612
         TM    CCBI+3,X'04'                                             10543613
         BC    1,RAT                                                    10543614
         TM    USW,X'40'                                                10543615
         BC    1,BN7                                                    10543616
         BC    15,LAB3                                                  10543617
BN7      LA    14,LAB3                                                  10543618
         STH   14,URET                                                  10543619
         LH    14,ULAB2                                                 10543620
         BCR   15,14                                                    10543621
BN6      NI    LABSW,X'EF'                                              10543622
         SVC   0                                                        10543623
         DC    YL2(CCBP)                                                10543624
         TM    CCBP+2,X'80'                                             10543625
         BC    8,*-4                                                    10543626
RAT      MVI   SWTIME,X'FF'                                             10543627
         OI    USW,X'40'                                                10543628
         LH    5,LLABRT                                                 10543629
         BCR   15,5                                                     10543630
         CNOP  0,8                                                      10543631
CCBP     DC    F'0'                                                     10543632
         DC    X'0014'                                                  10543633
         DC    YL2(CCWP)                                                10543634
CCWP     DC    X'09'                                                    10543635
         DC    AL3(PM)                                                  10543636
         DC    X'0000'                                                  10543637
         DC    X'000D'                                                  10543638
PM       DC    C'NO EOV OR EOF'                                         10543639
R1       OI    LABSW,X'10'                   PUT 1 IN 4 BIT             10543640
         NI    LABSW,X'7F'                   PUT 0 IN 1 BIT             10543641
CONT     PACK  FILPAC(8),LABEL+54(6)                                    10543642
         CVB   5,FILPAC                                                 10543643
         MVI   SWTIME,X'00'                                             10543644
         C     5,LIBKC                                                  10543645
         BC    7,MES9                                                   10543646
         BC    15,LAB3                                                  10543647
R2       OI    LABSW,X'90'                   PUT 1 S IN BITS 4 AND 1    10543648
         BC    15,CONT                                                  10543649
MES9     SVC   2                                                        10543650
       DC    C'3IBCA '                                                  10543651
         BC    15,LAB3                                                  10543652
BN3      TM    USW,X'80'                                                10543653
         BC    1,BN4                                                    10543654
         BC    15,LREAD2                                                10543655
BN4      LA    14,LREAD2                                                10543656
         STH   14,URET                                                  10543657
         LH    14,ULAB1                                                 10543658
         BCR   15,14                                                    10543659
PER      SVC   0                                                        10543660
         DC    YL2(CCBI)                                                10543661
         TM    CCBI+2,X'80'                                             10543662
         BC    8,*-4                                                    10543663
         BCR   15,14                                                    10543664
SWTIME   DC    X'FF'                                                    10543665
LMAIN1   DS    13F                                                      10543666
         CNOP  0,8                                                      10543667
CCBI     DC    F'0'                                                     10543668
         DC    X'0000'                                                  10543669
       DC    YL2(CCWI7)                                                 10543670
CCWI7  CCW   X'3F',LABEL,X'40',01                                       10543671
CCWI     DC    X'00'                                                    10543672
         DC    AL3(LABEL)                                               10543673
         DC    X'0000'                                                  10543674
         DC    X'0050'                                                  10543675
SW3      DC    X'00'                                                    10543676
         CNOP  0,8                                                      10543677
SAVE8    DC    F'0'                                                     10543678
UIN      DC    C'UIN'                                                   10543679
*                                                                       10543680
*                                                                       10543681
*                                                                       10543682
LAB1     MVC   CCBI+5(1),LICU           GET INPUT CURRENT UNIT          10543683
       LH    14,22                                                      10543684
       AH    14,CCBI+4                                                  10543685
       MVI   CCWI7,X'3F'                                                10543686
       OC    CCWI7(1),3(14)                                             10543687
       XI    CCWI7,X'14'                                                10543688
LSAVE    L     8,SAVE8                  LOAD VOL SEQ NO IN REG 8        10543689
         LH    1,LAAST                                                  10543690
LREW1    MVI   CCWI,X'07'                                               10543691
         BAL   14,PER                   REWIND TAPE                     10543692
         MVI   CCWI,X'02'                                               10543693
         BAL   14,PER                   READ TAPE  VOL1                 10543694
         CLC   LABEL(4),VOL1            MATCH VOL1                      10543695
         BC    7,LREW2                                                  10543696
         TM    SW3,X'FF'                1ST REEL                        10543697
         BC    1,LREAD1                 BRANCH IF ON SECOND REEL        10543698
         CLC   1(3,1),UIN               MATCH VOL SERIAL NO T/C  GET CA 10543699
         BC    8,NUEVA1                                                 10543700
         TM    LABSW,X'40'                                              10543701
         BC    1,ABART                                                  10543702
         LA    1,83(1)                                                  10543703
         CLC   1(3,1),UIN                                               10543704
         BC    7,ABART                                                  10543705
NUEVA1   STH   1,LAASTI                                                 10543706
         CLC   25(6,1),LABEL+4                                          10543707
         BC    7,LMES1                  BRANCH UNEQUAL                  10543708
LREAD1   MVI   CCWI,X'02'                                               10543709
         BAL   14,PER                   READ TAPE VOL                   10543710
         LH    1,LAASTI                                                 10543711
         CLC   LABEL(3),VOL1            MATCH VOL                       10543712
         BC    8,LREAD1                 BRANC EQUAL TO READ             10543713
         CLC   LABEL(4),HDR1            MATCH HDR1                      10543714
         BC    7,LLREW2                                                 10543715
         TM    SW3,X'FF'                1ST REEL                        10543716
         BC    1,LMOVE                  BRANCH IF NO 1ST REEL           10543717
         CLC   LABEL+4(49),8(1)         FILE LABEL CHECK                10543718
         BC    7,LMES2                  BRANCH UNEQUAL                  10543719
LSTARE   PACK  FILPAC(8),LABEL+27(4)                                    10543720
         CVB   8,FILPAC                 VOL SEQ NO TO REG 8             10543721
LREAD2   MVI   CCWI,X'02'                                               10543722
         BAL   14,PER                   READ TAPE  UNTIL TAPE MARK      10543723
         TM    CCBI+3,X'04'                                             10543724
         BC    1,LEND                                                   10543725
         CLC   LABEL(3),HDR1                                            10543726
         BC    8,LREAD2                                                 10543727
         BC    15,BN3                                                   10543728
LEND     MVI   SW3,X'FF'                SET ON SW3 1ST REEL             10543729
         ST    8,SAVE8                  STORE VOL SEQ NO COUNTER        10543730
         OI    USW,X'80'                                                10543731
         LH    5,LLABRT                 GET THE ADDRESS RETURN          10543732
         BCR   15,5                     BRANCH TO PH 4                  10543733
LLREW2   MVI   CCWI,X'0F'                                               10543734
         BAL   14,PER                                                   10543735
         SVC   2                                                        10543736
       DC    C'3IHDA '                                                  10543737
         BC    15,LREW1                                                 10543738
LREW2    MVI   CCWI,X'0F'                                               10543739
         BAL   14,PER                   REWIND UNLOAD                   10543740
         SVC   2                                                        10543741
       DC    C'3ISLA '                                                  10543742
         BC    15,LREW1                                                 10543743
LMES1    SVC   2                                                        10543744
       DC    C'3IVSA '                                                  10543745
         CLI   LMES1+7,C'R'                                             10543746
         BC    8,LREW1                                                  10543747
         BC    7,LREAD1                                                 10543748
LMOVE    MVC   31(4,1),LABEL+27                                         10543749
         CLC   LABEL+4(49),8(1)         FILE  LABEL C HECK ROUTINE      10543750
         BC    7,LMES3                                                  10543751
LSTORE   PACK  FILPAC(8),LABEL+27(4)                                    10543752
         CVB   7,FILPAC                                                 10543753
         LA    8,1(8)                   ADD ONE  REG8                   10543754
         CLR   7,8                                                      10543755
         BC    8,LREAD2                                                 10543756
         BC    7,LMES4                                                  10543757
LMES2    SVC   2                                                        10543758
       DC    C'3ICHA '                                                  10543759
         CLI   LMES2+7,C'R'                                             10543760
         BC    8,LREW1                                                  10543761
         BC    7,LSTARE                                                 10543762
LMES3    SVC   2                                                        10543763
       DC    C'3ICHA '                                                  10543764
         CLI   LMES3+7,C'R'                                             10543765
         BC    8,LREW1                                                  10543766
         BC    7,LSTORE                                                 10543767
LMES4    SVC   2                                                        10543768
       DC    C'3ISQA '                                                  10543769
         CLI   LMES4+7,C'R'                                             10543770
         BC    8,LSAVE                                                  10543771
         BC    7,LREAD2                                                 10543772
ABART  SVC   2                                                          10543773
       DC    C'3LCM  '                                                  10543774
       SVC   1                                                          10543775
         DC    C'SYSEOJ'                                                10543776
LMAIN2   DS    13F                                                      10543777
INI3     LA    1,LREAD2                                                 10543778
         STH   1,ULAB1                                                  10543779
         LA    1,LAB3             INPUT                                 10543780
         STH   1,ULAB2                                                  10543781
         LA    1,LABEL                                                  10543782
         STH   1,ULAB                                                   10543783
         LA    1,NEW                                                    10543784
         STH   1,ULAB3                                                  10543785
         LA    1,H3                                                     10543786
         STH   1,ULAB4                                                  10543787
         TM    LABSW,X'20'                                              10543788
         BC    8,LOAD                                                   10543789
         LA    1,LAB1                                                   10543790
         STH   1,LLABIH                                                 10543791
         LA    1,LAB2                   YES                             10543792
         STH   1,LLABOH                 LOAD ADDRESS IN                 10543793
         LA    1,LAB3                                                   10543794
         STH   1,LLABIT                                                 10543795
         LA    1,LAB4                      COMUN AREA                   10543796
         STH   1,LLABOT                                                 10543797
         LA    1,LAB5                                                   10543798
         STH   1,LLABOR                                                 10543799
LOAD     BC    15,STAT                                                  10543800
*                                                                       10543801
LIBKC    EQU   2524                                                     10543802
LICU     EQU   2522                                                     10543803
LLABIT   EQU   2536                                                     10543804
LLABIH   EQU   2532                                                     10543805
*                                                                       10543806
***   INITIALIZATION                                                    10543807
*                                                                       10543808
STAT     LH    1,IBKSZ        STORE COUNT AT COMMAND WORDS              10543809
         STH   1,CCWIA+6                                                10543810
         STH   1,CCWIB+6                                                10543811
         LH    1,OBKSZ                                                  10543812
         STH   1,CCWOA+6                                                10543813
         STH   1,CCWOB+6                                                10543814
         MVC   CCWIA+2(2),INA STORE STARTING ADDRESS AT COMMAND WORDS   10543815
         MVC   CCWIB+2(2),INB                                           10543816
         MVC   CCWOA+2(2),OUTA                                          10543817
         MVC   CCWOB+2(2),OUTB                                          10543818
         LA    1,CCBIA        SET INPUT CCB FOR AREA A                  10543819
         LA    2,CCBOA        SET OUTPUT CCB FOR AREA A                 10543820
         LH    4,IRCLN        SET REGISTER 4,5,6                        10543821
         LH    5,INA                                                    10543822
         STH   5,IAREA                                                  10543823
         LR    6,5                                                      10543824
         AH    5,IBKSZ                                                  10543825
         BCTR  5,0                                                      10543826
         LH    8,ORCLN        SET REGISTER 8,9,10                       10543827
         LH    9,OUTA                                                   10543828
         LR    10,9                                                     10543829
         AH    9,OBKSZ                                                  10543830
         BCTR  9,0                                                      10543831
         CLI   LABIH,C'*'     IS INPUT LABEL DEFINED                    10543832
         BC    7,*+24         YES, SKIP                                 10543833
         LA    7,P3IH+2       NO,  PROVIDE ADDRESSES                    10543834
         STH   7,LABIH                                                  10543835
         LA    7,P3IT+2                                                 10543836
         STH   7,LABIT                                                  10543837
         NI    P3IH+7,X'0F'                                             10543838
         MVC   ICU(1),IPA     SET CURRENT UNIT                          10543839
INLAB    CLI   LABOH,C'*'     IS OUTPUT LABEL DEFINED                   10543840
         BC    7,*+32         YES, SKIP                                 10543841
         LA    7,P3OH+2                                                 10543842
         STH   7,LABOH                                                  10543843
         LA    7,P3OT+2                                                 10543844
         STH   7,LABOT                                                  10543845
         LA    7,P3OR+2                                                 10543846
         STH   7,LABOR                                                  10543847
         NI    P3OHR+5,X'0F'                                            10543848
         MVC   OCU(1),OPA     SET CURRENT UNIT                          10543849
*                                                                       10543850
***   SETTING SWITCH ROUTINE                                            10543851
*                                                                       10543852
SSR      TM    TJOB,X'01'     IS COPY                                   10543853
         BC    8,IOSC11       NO, BRANCH TO IOSC11                      10543854
         OI    AB3+1,X'F0'                                              10543855
         NI    BA3+1,X'0F'                                              10543856
         OI    BD3+1,X'F0'                                              10543857
         TM    NOIO,X'01'     IS 1-INPUT-OUTPUT AREA                    10543858
         BC    8,STSR         NO, BRANCH TO STSR                        10543859
         OI    BB3+1,X'F0'                                              10543860
         BC    15,DAME                                                  10543861
STSR     NI    BB3+1,X'0F'    NO, 2-INPUT-OUTPUT AREAS                  10543862
         NI    BB2+1,X'0F'                                              10543863
         BC    15,DAME                                                  10543864
IOSC11   TM    NOIO,X'11'     ARE 1-INPUT 1-OUTPUT AREAS                10543865
         BC    12,IOSC12      NO, BRANCH TO IOSC12                      10543866
         OI    AB3+1,X'F0'                                              10543867
         OI    BD3+1,X'F0'                                              10543868
         NI    BB2+1,X'0F'                                              10543869
         BC    15,DAME                                                  10543870
IOSC12   TM    NOIO,X'12'     ARE 1-INPUT 2-OUTPUT AREAS                10543871
         BC    12,IOSC21      NO, BRANCH TO IOSC21                      10543872
         OI    AB3+1,X'F0'                                              10543873
         NI    BB2+1,X'0F'                                              10543874
         NI    BD3+1,X'0F'                                              10543875
         BC    15,DAME                                                  10543876
IOSC21   MVI   ISVC,X'0A'                                               10543877
         NI    AB3+1,X'0F'                                              10543878
         OI    BB2+1,X'F0'                                              10543879
         TM    NOIO,X'21'     ARE 2-INPUT 1-OUTPUT AREAS                10543880
         BC    12,IOSC22      NO, BRANCH TO IOSC22                      10543881
         OI    BD3+1,X'F0'                                              10543882
         BC    15,DAME                                                  10543883
IOSC22   NI    BD3+1,X'0F'                                              10543884
DAME     STM   1,10,REG                                                 10543885
         SVC   1                                                        10543886
         END   STRT                                                     10543887
