SYSS00   START 0                                                        10510002
         USING *,0,4                                                    10510003
         ORG   SYSS00+5                                                 10510004
         DC    C' '                                                     10510005
         ORG   SYSS00+88                                                10510006
         DC    X'00040000'              NEW  EXT SIGNAL PSW             10510007
         DC    A(SYSEXT)                                                10510008
         DC    X'00040000'              NEW  SVC INTRT  PSW             10510009
         DC    A(SYSSVC)                                                10510010
         DC    X'00040000'              NEW  PROG CHECK PSW             10510011
         DC    A(SYSSPC)                                                10510012
         DC    X'00060000'              NEW  MACH CHECK PSW             10510013
SYSSMD         DC   X'F0FFFFFF'                                         10510014
         DC    X'00040000'              NEW  IO INTERPT PSW             10510015
         DC    A(SYSXIN)                                                10510016
         DC    YL2(SYSSCR)                                              10510017
         DC    YL2(SYSUTB)                                              10510018
       ORG   SYSS00+144                 DIAGNOSTICS USE 8 BYTES  START  10510019
SYSSLB     DC    X'FF0500000F'                                          10510020
         DC    AL3(SYSLDR)             USE ABSOLUTE LOADER              10510021
SYSS83   DS    D                       TO SAVE PSW BEFORE TIMER RTN     10510022
SYSS86   DS    D                                                        10510023
SYSS81   LM    10,11,SYSS86                                             10510024
         LPSW  SYSS83                  RETURN FROM TIMER RTN            10510025
SYSS84   DS    D                       TO SAVE PSW BEFORE OP.COM RTN    10510026
SYSS87   DS    D                                                        10510027
SYSS03   DC    X'09000000'              CCW WRITE MSG                   10510028
         DC    F'5'                                                     10510029
SYSS04   DC    X'0A000005'              CCW READ  REPLY                 10510030
         DC    F'1'                                                     10510031
SYSZVE   DS    F                       TO SAVE REG 10 FOR MSG HANDLING  10510032
SYSSAC   DS    F                       TO SAVE  REPLY ADDRESS           10510033
SYSSCB   DC    X'1000'                 DUMMY CCB FOR SVC 2 FORCE RTRN   10510034
SYSS93   MVC   24(8),32                                                 10510035
         B     SYSS13                                                   10510036
SYSTWA   DC    X'001F'                 TW ADDRESS                       10510037
SYSSVC   L     12,36                    LOAD ADD IN R12                 10510038
       CLI   35,X'01'       IS V SVC 1                                  10510039
         BL    SYSXCP                   GO TO IOCS (CODE 0)             10510040
         BE    SYSS11                   GO TO FETCH ROUTINE (CODE 1)    10510041
       CLI   35,X'03'       IS V SVC 3                                  10510042
         BNL   SYSS80                                                   10510043
SYSS06   MVC   0(5),0(12)               CODE 2    MESSAGE               10510044
         LA    12,6(12)                 CALCULATE NEXT INSTRUCTION ADDR 10510045
         IC    13,36                   STORE ADDRESS IN PSW             10510046
         ST    12,36                                                    10510047
         STC   13,36                                                    10510048
         BCTR  12,0                    CALCULATE EDDRESS FOR REPLY      10510049
         MVI   SYSS03+4,X'20'          SUPPRESS CHAINING IN CCW         10510050
         CLI   4,C'A'                   IF A  REPLY                     10510051
         BNE   *+8                      IS WANTED PUT CHAINING BIT      10510052
         MVI   SYSS03+4,X'60'                                           10510053
         ST    12,SYSSAC               SAVE ADDRESS FOR REPLY           10510054
         MVC   58(2),SYSTWA            LOAD CH,UNIT ADDRESS             10510055
       LA    12,SYSMSG-SYSQMX                                           10510056
       ST    10,SYSZVE                                                  10510057
         BAL   10,SYSQXS               USE ROUTINE TO SET UP CCW AND T5 10510058
         DC    YL2(SYSS03)             CCW ADDRESS                      10510059
       L     10,SYSZVE                                                  10510060
         TM    SYSSCB,X'20'                                             10510061
         BC    8,SYSS93                 NOT DISASTER,CONTINUE           10510062
SYSS09   OI    32,X'01'                 UNMASK EXT IN                   10510063
         OI    33,X'02'                 AND ENTER WAIT STATE            10510064
SYSXST LPSW  32                         RETURN TO MAIN LINE   SVC       10510065
SYSS82   LM    10,11,SYSS87                                             10510066
         NI    SYSSOC+1,X'0F'          ACCEPT NEXT ATTENTION ON 1052    10510067
         LPSW  SYSS84                  RETURN FROM OP.COM. RTN          10510068
SYSS80   CLI   35,X'04'                                                 10510069
         BE    SYSS82                  CODE 3  RETURN FROM OP.COM RTN   10510070
         BL    SYSS81                  CODE 3  RETURN FROM TIMER RTN    10510071
SYSS10   MVI   35,X'10'                 SVC CODE ERROR                  10510072
         MVC   40(8),32                 SIMULATE PROG CHECK             10510073
         B     SYSSPC                   WITH INTRT CODE 00010000        10510074
SYSSAT   MVC   32(8),SYSSLB             MOVE  PROB PSW                  10510076
SYSS11   CLC   0(6,12),SYSSLC           COMPARE NAME WITH EOJ           10500075
         BNE   SYSS09+8                 LOAD PSW                        10510077
         B     SYSS09+4                 LOAD PSW WITH WAIT STATE        10510078
SYSEXT   TM    27,X'80'                IS IT TIMER INTERRUPT            10510079
         BO    SYSSTM                  GO TO HANDLING OF TIMER INTERRUP 10510080
SYSS13   CLI   4,C'A'                   IF REPLY NOT REQUIRED           10510081
         MVI   4,C' '                                                   10510082
         BNE   SYSS15                   IGNORE THIS MSG                 10510083
         L     12,SYSSAC                                                10510084
         MVC   0(1,12),5                MOVE REPLY IN CALLING SEQUENCE  10510085
         CLI   5,C' '                                                   10510086
         BE    SYSS15                   IGNORE CODE IF BLANK            10510087
         NI    5,X'FC'                 IS CODE 0 TO 4 IN BINARY         10510088
         CLI   5,X'F0'                  OR CHARACTER FORM               10510089
         BE    SYSS17                                                   10510090
SYSS14   CLI   5,X'02'                  IF CODE 0 OR 1                  10510091
         BL    SYSS18                   GO TO ABNORMAL END OF JOB       10510092
         CLI   5,X'03'                                                  10510093
         BE    SYSS99                                                   10510094
         BL    SYSS19                   GO TO -SET 7TH BIT ON IN UPSI - 10510095
SYSS15   MVI   5,C' '                   IGNORE OR END OF MSG-REPLY      10510096
         NI    25,X'FD'                 PROCESSING                      10510097
SYSS16   LPSW  24                                                       10510098
SYSS99   NI    SYSUPS,X'FE'                                             10510099
         B     SYSS15                                                   10510100
SYSS17 MVC   5(1),0(12)                                                 10510101
         NI    5,X'0F'                           INTO BINARY FORM       10510102
         B     SYSS14                                                   10510103
SYSS19   OI    SYSUPS,X'01'            SET ON 8TH BIT OF UPSI           10510104
         B     SYSS15                                                   10510105
SYSS20   DC    H'1'                                                     10510106
SYSSTM   MVC   SYSS83(8),24            SAVE OLD PSW                     10510107
         STM   10,11,SYSS86                                             10510108
         LH    12,SYSRTA+2             IS AN USER(S RTN PROVIDED        10510109
         LTR   12,12                                                    10510110
         BZ    SYSS81                  NO - RETURN                      10510111
         STH   12,30                   YES - GO TO THIS ROUTINE         10510112
         LPSW  24                                                       10510113
SYSSOC   BC    0,SYSSCX                ACCEPT OR NOT ATTENTION ON 1052  10510114
         MVC   SYSS84(8),56            SAVE OLD PSW                     10510115
         STM   10,11,SYSS87                                             10510116
         SVC   2                       MACRO TO ASK FOR THE CODE        10510117
         DC    C'0902A '                                                10510118
         LH    12,SYSRTA+4             IS AN USER,S RTN PROVIDED        10510119
         LTR   12,12                                                    10510120
         BZ    SYSS82                  NO - RETURN                      10510121
         STH   12,62                   YES - GO TO THIS ROUTINE         10510122
         OI    SYSSOC+1,X'F0'          1052 ATTENTION NOT ACCEPTED      10510123
SYSSCX   LPSW  56                                                       10510124
         DS    0F                                                       10510125
SYSS21   DC    X'0000FFFF'              MASK FOR LOAD HALFWORD          10510126
SYSSCR   DC    F'0'                    COMMUNICATION REGION- MONTH-DAY  10510127
         DC    H'0'                                           YEAR      10510128
         DC    X'000000'                                      DATE      10510129
         DC    X'00'                                          CONFIG    10510130
SYSEND   DC    YL2(SYSSND)             END OF SUPERVISOR                10510131
SYSUSR   DC    2F'0'                   FOR USER - RESET BY SYSEOJ       10510132
         DC    3C'0'                             NOT RESET              10510133
SYSUPS   DC    X'00'                   UPSI                             10510134
SYSS26   DC    C'NAMEXX'                                                10510135
SYSRTA   DC    2FL4'0'                 PC-TIMER-OP.COM-1015 ROUTINES    10510136
         DC    X'0000'                 SYSEOJ SWITCHES                  10510137
SYSSPC   LH    13,SYSRTA                                                10510138
               CH   13,SYSS20                                           10510139
         BC    12,SYSSPD                                                10510140
               MVC  32(8),40                                            10510141
               STH  13,38                                               10510142
               LPSW 32                                                  10510143
SYSSPD         SVC  2                                                   10510144
         DC    C'0901  '               MESSAGE FOR PROG CHECK           10510145
SYSS18   CLR   13,13                    RESET COND CODE TO ZERO         10510146
         MVI   5,C' '                                                   10510147
         B     SYSS11+6                   AND BRANCH TO LOAD PROB PSW   10510148
SYSSLC   DC    C'SYSEOJ'                                                10510149
*                                                                       10510150
SYSUTB   DC    X'00000005'             SYSRES CONTAINS PUB LIMITS       10510151
       DC    X'00080801'                1402,UNIT 08,SYSRDR             10510152
       DC    X'00100602'                1403,UNIT 10,SYSLST             10510153
       DC    X'000A0403'                1442,UNIT 0A,SYSIPT             10510154
       DC    X'00040A04'                1402,UNIT 04,SYSOPT             10510155
SYSUTY DC    X'001F0200'                1052,UNIT 1F,SYSLOG             10510156
         DC    X'00000000'             SYS000                           10510157
         DC    X'00000000'             SYS001                           10510158
         DC    X'00000000'             SYS002                           10510159
         DC    X'00000000'             SYS003                           10510160
         DC    X'00000000'             SYS004                           10510161
*  *  *  TAPE BIASED SIMPLER SCHEDULER *  *  *                          10510162
SYSENS   EQU   SYSS00+24                HOLD C SENSE INFO               10510163
SYSHLD EQU   8           HOLDING AREA FOR TYPE MSG                      10510164
SYSUSE EQU   19                         BYTE SHOWS ACTIVITY ON CHANNLS  10510165
*            * * * REQUEST I/O ENTRY POINT * * *                        10510166
* * *  SPVR  LOADED REG 12  FOR ME                                      10510167
SYSXCP LH    13,0(12)                   LOAD CCB ADDRESS                10510168
* * *  NEED  AND ABOVE 32 K                                             10510169
       LA    12,2(12)                   ADD 2 TO GET RETURN ADDRESS     10510170
       STH   12,38                      STORE RETURN ADDRESS            10510171
       NC    0(5,13),SYSXZA             ZERO LINK AND COMMUNICATIONS    10510172
SYSQDE   TM    2(13),X'04'              SHOULD THIS CCB WAIT FOR DEV E  10510173
         BC    8,SYSAAA                 BYPASS STASH IN WAITING LIST    10510174
* * *    PUSH DOWN LIST OF DEVICES SIG AT DEV END                       10510175
       STH   13,SYSVCB                  STORE CCB ADDRESS               10510176
         MVC   SYSA01(SYSLNG),SYSA01+2       PUSH DOWN LIST             10510177
SYSAAA  EQU  *                                                          10510178
       STH   13,SYSVCB                  SAVE CCB ADDRESS                10510179
       LH    13,4(13)                    LOAD SYMBOLIC ADDRESS          10510180
       SR     12,12                     ZERO REGISTER                   10510181
       IC    12,SYSUTB(13)              PULL CHANNL                     10510182
       AR     12,12                     DOUBLE CHANNEL                  10510183
       OC    SYSUSE(1),SYSXCN-SYSS00(12) SET CHANNEL USE BYTE           10510184
*            * * * PLACE CCB AT END OF Q AND LINK * * *                 10510185
       LA    13,SYSQMX(12)              LOAD ADDRESS OF HEAD OF Q       10510186
SYSQLL CLI   0(13),X'00'                TEST CORE FOR BLANK ADRESS      10510187
       BC    8,SYSQLK                   END OF Q   SO PASS TO STORE CCB 10510188
       LH    13,0(13)                   PULL LINKAGE ADDRESS            10510189
     B       SYSQLL                                                     10510190
SYSQLK MVC   0(2,13),SYSVCB               PUT THIS CCB AT END OF Q      10510191
       CLI   SYSXPT-SYSS00(12),X'07'    EXPECT INTERRUPT THIS CHANNEL Q 10510192
       BNE   SYSXST                     EXIT SUPVR IF NOW EXPECT INTRPT 10510193
SYSQST MVC   56(8),32                                                   10510194
*            * * * START I/O FOR THIS Q      * * *                      10510195
SYSUA1 LH    13,SYSQMX-SYSS00(12)       PULL HEAD OF Q CCB ADDR         10510196
       MVC   74(2),6(13)                PULL CCW ADDR INTO CAW          10510197
       LH    13,4(13)                   LOAD SYMBOLIC ADDRESS           10510198
         CLI   SYSUTB-SYSS00+2(13),X'00'     IS THIS DEVICE A TAPE      10510199
         BNE   SYSWF1                   BRANCH IF NOT                   10510200
         NI    SETMOD,X'03'             SET MODE BITS OFF               10510201
         OC    SETMOD(1),SYSUTB-SYSS00+3(13)      SET MOD ON            10510202
         MVC   SYSTIC+2(2),74          PLACE CCW INTO TIC               10510203
         MVC   74(2),ADSTMD+2           PLACE SET MODE ADDR INTO CAW    10510204
SYSWF1   LH    13,SYSUTB(13)            PUT CHNL, DEVICE IN REGISTER    10510205
SYSWFH   B       SYSWIO            BYPASS WOIT                          10510206
       MVI   SYSWUP+1,X'F0'             TURN SWUP TO BRANCH             10510207
         MVI     SYSXWW+1,X'00'                                         10510208
         TIO     0(13)             CHECK CHANNEL END                    10510209
         BC      6,*-4             WAIT FOR DEVICE END                  10510210
*            * * * START I/O ROUTINE    * * *                           10510211
SYSWIO SIO   0(13)           START IO                                   10510212
       STH   13,58                      IF CSW STORED NEED CH/UN ADRES  10510213
       BC    7,*+8            BYPASS SET EX PECT                        10510214
       STH   13,SYSXPT-SYSS00(12)       MOVE CHNL,DEVICE TO 5XP53T 9N3  10510215
       BC    10,SYSXWW                  GET OUT IF CC IS 0,2            10510216
       BC    1,SYSXMN                   OVERFLO FOR NOT OPERATIONAL     10510217
         NI    SYSUIS+1,X'0F'           IMMEDIATE END                   10510218
       TM    68,X'10'                   DEVICE BUSY                     10510219
       BC    12,SYSXBB                  NO SO ERR OR IMMED END          10510220
       TM    68,X'04'                   DEVICE END                      10510221
       BC    1,SYSWIO                   TRY AGAIN D.E INT WAS PENDING   10510222
SYSXWW BC    15,SYSXIT                  BUSY BUT NO END SAYS TRY LATER  10510223
       TIO   0(13)                                                      10510224
       BC     2,*-4              WAIT FOR CHANNEL END                   10510225
       BC    15,SYSXBB                  END OF WAIT,CHECK ERRORS        10510226
*            * * * I/O INTERRUPT                                        10510227
SYSXIN SR     12,12                     ZERO REGISTER                   10510228
         OI    SYSUIS+1,X'F0'           I/O INTRPT  NOT INISL SELECTION 10510229
       IC    12,58                       INSERT CHANNEL                 10510230
       AR    12,12                      DOUBLE CHANNEL                  10510231
SYSXCK CLC   SYSXPT-SYSS00(2,12),58      EXPECT INTRUPT THIS CH,DEVICE  10510232
      BC  7,SYSXAT       TEST ATTENTION ETC                             10510233
* * *  ANALYSE FOR ERRORS, INTERRUPT OR CSW STORED                      10510234
SYSXBB LH    13,SYSQMX-SYSS00(12)       LOAD CCB ADDRESS FOR SET ERR FL 10510235
       TM    69,X'3F'                   TEST CHNNL,DATA,CONTROL,INTFACE 10510236
       BC    7,SYSQCC                   CHANNNEL ERRORS HARD STOP       10510237
SYSXCC TM    68,X'01'                   TEST UNIT EXCEPTION,END FILEETC 10510238
       BC    8,SYSXUC                   BR TO UNIT TEST UNIT CHECK      10510239
       OI    3(13),X'04'                TURN ON UNIT EXCEPTION          10510240
SYSXUC TM    68,X'02'                   UNIT CHECK                      10510241
       BC    7,SYSWUC                   YES,GO TO WORK UNIT CHECK       10510242
* * *  NO ERRORS ASSUME CHANNEL END                                     10510243
SYSUDE TM    68,X'04'                   DEVICE END                      10510244
       BC    8,SYSWUP                   NO LEAVE IT IN LITST            10510245
       OI    3(13),X'01'                SET END  DEV END BIT            10510246
SYSWUP BC    0,SYSQXC                   ER RTN CUT Q BY BRANCH HERE     10510247
       TM    69,X'80'                   PROG  CONTR INTR                10510248
       BC    8,SYSPST             NO CONTINUE                           10510249
         OI    4(13),X'80'              TURN PCI BIT ON                 10510250
         TM    69,X'08'                 CHANNEL END                     10510251
         BNE   SYSXIT                                                   10510252
SYSPST OC    2(1,13),69                 OR IN WLR,PCI  BITS             10510253
       OI    2(13),X'80'                POST TRAFFIC BIT                10510254
SYSUPD MVI   SYSXPT-SYSS00(12),X'07'    SAY CHNL NOT EXPECT INTERRUPT   10510255
       MVC   SYSQMX-SYSS00(2,12),0(13)  MOVE NEXT TO HEAD OF Q          10510256
       MVC   0(2,13),70                 PUT RESIDUAL COUNT IN CCB       10510257
SYSQTT CLI   SYSQMX-SYSS00(12),X'00'     IS Q EMPTY                     10510258
       BC    6,SYSUA1                   NO,TRY TO START I O             10510259
       NC    SYSUSE(1),SYSXCN+1-SYSS00(12) CLEAR BIT IN CHANNEL USE BY  10510260
SYSXIT LPSW  56                         RETURN VIA LOAD OLD PSW         10510261
SYSXRS XC    SYSQMX(8),SYSQMX           TURN Q A TO ZERO                10510262
       MVI   SYSXPT,X'07'               NOT EXXECT ON MPX CHANNEL       10510263
       MVC   SYSXPT+1(7),SYSXPT         NOT EXPECT ON ANY CHNNL         10510264
       MVI   SYSUSE,X'00'               SET CHANNEL ACTIVITY TO ZERO    10510265
SYSVRR MVI   SYSWUP+1,X'00'             NOP ERR I/O RETURN IF ERR CH OK 10510266
         MVI     SYSXWW+1,X'F0'         RESET BRANCH AFTER SIO          10510267
       MVI   SYSQXR+1,X'F0'             SET SWITCH TO BR AS NORMAL      10510268
       MVI   SYSWFH+1,X'F0'             SET SW TO BRANCH                10510269
       CLI   SYSWFF+1,X'00'  '             IS SWITCH TO BRANCH          10510270
       BCR   8,13                       NO, RETURN                      10510271
         LM    1,11,SYSVRX              RESTORE REGISTERS               10510272
       MVI   SYSWFF+1,X'00'             SWITCH TO SAVE PSW              10510273
       BCR   15,13                     RETURN                           10510274
*            * * * TEST UNIT CHECKS     * * *                           10510275
SYSWUC OI    2(13),X'20'                SET UNCORRECTABLE ERROR BIT CCB 10510276
       TM    2(13),X'01'                USER ERROR RTN                  10510277
       BC    1,SYSWUP                   YES,RETURN TO USER              10510278
SYSWFF BC    0,SYSXFF                   BYPASS SAVE PSW AND STATUS      10510279
SYSVRZ   STM   1,11,SYSVRX              SAVE REGISTERS FOR WORK         10510280
       LM    1,5,SYSAVE       SAVE CORE BY REG   BCR  * * *             10510281
       MVI   SYSQCT,X'0'                SERO ERROR COUNTER              10510282
SYSXFF OI    SYSWFF+1,X'F0'              TURN ON SWITCH TO BYPASS SAVE  10510283
         MVI     SYSWFH+1,X'00'    NOP  SWITCH                          10510284
       LH   11,66                       NEXT CCW     INTO REG           10510285
         SH   11,SYSC08                SUBTRACT 8 TO GET LAST CCW       10510286
       STH  11,66         SAVE NEW CCW IN CORE                          10510287
       MVC   SYSVCW(12),64               SAVE CSW,   CAW                10510288
       MVI     50,X'1F'                 1F  FOR UNIT CHECK              10510289
       XC    SYSENS(6),SYSENS           SET SENSE TO ZERO               10510290
       LH    9,58                                                       10510291
       MVC   74(2),SYSXSC                SENSE CCW                      10510292
       SIO   0(9)                       SENSE                           10510293
         BC    6,*-4                                                    10510294
* * * *      ASSUMED  NO ERRORS ON SENSE  SINCE UNIT CHECK SAYS CONTR   10510295
* * * *                UNIT IS OPERATIONAL                              10510296
* * * *      ASSUME  NO OUTSTANDING INTRPS SINCE GOT SOME KIND OF ENDA  10510297
* * * *              SHORT WHILE BACK                                   10510298
       TIO   0(9)                                                       10510299
       BC   2,*-4            WAIT FOR END OF SENSE                      10510300
       MVC   64(12),SYSVCW                   RESTORS   CSW  CAW         10510301
       IC    8,SYSQCT                   READY TO STEP COUNTER           10510302
SYSCSP LA    8,1(8)                     ADD ONT TO COUNTER              10510303
       STC   8,SYSQCT                   PUT CNTR IN CORE                10510304
       LH     8,4(13)                   PULL SYMBOLIC UNIT              10510305
       IC     8,SYSUTB+2(8)              PULL DEVICE TYPE               10510306
       LH    8,SYSXTE(8)               PULL TABLE ADDRESS               10510307
       BCR   15,8                                                       10510308
SYSQCC MVI   50,X'0F'                   CHANNEL ERROR                   10510309
       LPSW   112                       SIMULATE MACH CHECK             10510310
SYSXMN   MVI     50,X'3F'          NOT OPERATIONAL  3F                  10510311
       LH    13,SYSQMX(12)              PULL CCB ADDRESS                10510312
*            * * * DISTASTER OR DUMP EXIT * * *                         10510313
SYSQXD OI    2(13),X'20'                DISASTER BIT                    10510314
       TM    2(13),X'10'                ACCEPT BAD I/O                  10510315
       BC    1,SYSQXK                   YES  CONTINUE  NO CLEAR DISAST  10510316
* * *  DISASTER BIT ONLY BELONGS ON IF BITS X'11' I(13) ARE ON * * * *  10510317
       LPSW    112                                                      10510318
* * *  OPERATOR CHOICE EXIT                                             10510319
SYSQXP UNPK  SYSHLD(5),58(3)            PUT CH/UN REL                   10510320
SYSC08   EQU   *-4                     CONSTANT OF 8                    10510321
       UNPK  SYSHLD+4(5),SYSENS(3)      UNPACK SENSE INFO               10510322
       TR    SYSHLD(8),SYSTBL-240       CONVERT HEX TO CHARACTER FOR PR 10510323
       MVC   SYSXM1(4),SYSHLD           SET MESSG1 FOR MACRO            10510324
       MVC   SYSXM2(4),SYSHLD+4         SET MESSG2 FOR MACRO            10510325
         STM   12,13,SYSDRG             SAVE REGISTERS SINCE SUP USES T 10510326
       SVC   2           CALL VOR MESSAGE                               10510327
SYSXM1   DC    C'CHUN  '                CHANNEL AND UNIT MESSAGE        10510328
       SVC   2           CALL FOR MESSAGE                               10510329
SYSXM2   DC    C'SENSA '                SENSE MESSAGE                   10510330
         LM    12,13,SYSDRG             RESTORE SAVED REGISTER S        10510331
       CLI   SYSXM2+5,C'5'              IS REPLY RETRY                  10510332
* * *  RETRY EXIT                                                       10510333
       BC    8,SYSQXR                   GO TO RTN                       10510334
*            * ** CONTINUE EXIT         * * *                           10510335
SYSQXC NI    2(13),X'DF'                TURN OFF DISASTER BIT           10510336
SYSQXK CLI   SYSQXR+1,X'00'             WAS THIS I/O FROM RROR RTN      10510337
SYSXEE   MVI     SYSQXR+1,X'F0'    SWITCH FOR RESET OPER  SET IT TO BR  10510338
          BC     8,2(10)                   RETURN TO ERR RTN            10510339
       BAL   13,SYSVRR                 RESTORE REGISTERS                10510340
SYSWDE BC  0,SYSPDE                                                     10510341
       LH    13,SYSQMX-SYSS00(12)       LOAD CCB ADDRESS F              10510342
       BC    15,SYSWUP                  UPDATE AND CONTINUE             10510343
SYSQXR BC    15,SYSUA1                  NORMAL RETRY                    10510344
SYSQXS MVC   74(2),0(10)                LOAD CAW                        10510345
       LH    13,58          SET UP CHANNEL,UNIT ADDRESS                 10510346
       OI    SYSWUP+1,X'F0'             TURN SWUP TO BRANCH             10510347
         MVI     SYSQXR+1,X'00'    SWITCH FOR RESET OPER  NOP           10510348
         MVI     SYSWFH+1,X'00'    NOP  SWITCH                          10510349
       BC    15,SYSWFH+4                USE  NORMAL START AND TESTS     10510350
SYSSOF   TM    2(13),X'02'              TEST SELECTED ERROR BIT         10510351
         BCR   8,1                      EXIT IF NOT ON                  10510352
         B     SYSXEE                  CONTINUE IF ON                   10510353
SYSXAT   EQU  *                                                         10510354
SYSUNX   LA    12,SYSVCB                 INITIALIZE SEARCH FOR DEV END  10510355
SYSAL1   SH    12,SYSC02                 SUBTRACT 2                     10510356
         CLI   0(12),X'00'              NO CCB                          10510357
         BE    SYSA00                   NONE TRY TESTING Q              10510358
         LH    13,0(12)                 PULL CCB                        10510359
         LH    13,4(13)                 PULL SYMBOL UNIT                10510360
         CLC   SYSUTB-SYSS00(2,13),58   COMPARE INTR CR/UNIT/S CCB C/UN 10510361
         BNE   SYSAL1                   NOT THIS DEVICE                 10510362
         MVI   SYSWUP+1,X'F0'           CUT AT END OF CHECKS            10510363
         MVI   SYSWDE+1,X'F0'           RETURN HERE  DEV END SWITCH     10510364
         LH    13,0(12)                 SET CCB                         10510365
         B     SYSXBB+4                 SIGNIF.INT-CHECK CONDITIONS W/R 10510366
SYSPDE   MVI   SYSWDE+1,X'00'           NOP  DEV END SW                 10510367
         SH    12,SYSC02                POP UP LIST                     10510368
         MVC   2(2,12),0(12)            UPDATE OUTSTANDING D.E POSSIBLE 10510369
         CLI   0(12),0                  END OF SIG LIST                 10510370
         BNE   SYSPDE+4                 POP UP THE LIST                 10510371
SYSA00   SR    12,12                    SET REG 12 IF ANY SEL CH S POIN 10510372
       IC    12,58                       INSERT CHANNEL                 10510373
       AR    12,12                      DOUBLE CHANNEL                  10510374
SYSQTS CLI   SYSXPT-SYSS00(12),X'07'    AT DEVICE END  NEED TO TST EXPT 10510375
       BC    4,SYSXIT                   LESS,REALL CHANNEL NUMBER       10510376
     B     SYSQTT                                                       10510377
* * *    CHECK DEVICE END                                               10510378
SYSC02 DC  H'2'                                                         10510379
* * *    DESIGNED FOR PRTOV MACRO                                       10510380
       DC  H'0'                                                         10510381
SYSA01 DC   2H'0'                       PUSH DOWN LIST FOR DVE SIG CCB  10510382
       DC   2H'0'                                                       10510383
LAST   DC   2H'0'                                                       10510384
SYSVCB DC    H'0'                                                       10510385
L      EQU   SYSVCB-SYSA01              LINGTH OF PUSH DOWN LIST        10510386
SYSLNG EQU   SYSVCB-SYSA01              LENGTH OF PUSH DOWN LIST        10510387
* * *    IF DEVICE END SIGNIFIGANT, TEST CH9,CH12,WITH I/O ERROR RTNS.  10510388
SYSXZA DC    X'00001F000F'              MASK,AND BYTES 0-3 OFF          10510389
SYSQCT DC    X'0'                  COUNTER FOR ERROR ROUTINES           10510390
*      TABLE  OF ERROR ENTRYS           * * *                           10510391
SYSXTE DC   Y(SYSTER)           TAPE ERROR RTN                          10510392
       DC      Y(SYSUIS)                1052 TYPEWRITER  ERROR          10510393
       DC      Y(SYSUAA)                1442 READ/PCH   ERROR           10510394
       DC      Y(SYSUCG)                1403 PRINTER    ERR/R           10510395
       DC      Y(SYSUCD)                1402  READER    ERR/R           10510396
       DC      Y(SYSUCC)                1402 PUNCH,PFR  ERR/R           10510397
       DC     Y(SYSD10)           DISK ROUTINES                         10510398
       DC      Y(SYSUKA)                1015 ERROR ROUTINES             10510399
       DC      Y(SYSP00)                2671 ERROR ROUTINES             10510400
       DC      Y(SYSUAB)                1443 PRINTER   ERROR            10510401
SYSUKA EQU   SYSQXD                     NO 1015 ERROR ROUTINES          10510402
SYSD10   EQU   SYSQXD                                                   10510403
SYSP00 EQU   SYSQXD                     NO 2671 ERROR ROUTINES          10510404
SYSXSC DC      Y(SYSXSN)                ADDR OF SENSE CCW               10510405
*                                                                       10510406
SYSQMX DC    3H'0'                      HEAD Q FOR MULTPLX,2SEL         10510407
SYSMSG   DC      Y(SYSSCB-2)           POINT TO CCB FOR SVC2            10510408
SYSXCN DC    X'807F'                    OR CH USE BYTE    AND IT OFF    10510409
       DC    X'40BF'                    OR CH USE BYTE    AND IT OFF    10510410
       DC    X'20DF'                    OR CH USE BYTE    AND IT OFF    10510411
SYSXPT DC    3X'0700'                   EXPECT INTERRUPT ON CHANNL      10510412
       DC     X'0700'                                                   10510413
***   AREA FOR SAVING REGISTERS                                         10510414
SYSVRX   DS    11F                      ROOM TO SAVE REMAINING REG.     10510415
SYSDRG   DS    D                                                        10510416
SETMOD   CCW   X'03',SETMOD,X'60',80     SET MODE COMMAND               10510417
SYSTIC   DC    X'08000000'              TIC COMMAND                     10510418
ADSTMD   DC      A(SETMOD)              ADDRESS OF SET MODE COMMAND     10510419
       DC  X'00FAFBFCFDFEFF00'          TRANSLATE LETT5RS 256OR5 G+     10510420
SYSXSN CCW   X'04',SYSENS,X'20',6       SENSE BYTES I/O CCW             10510421
SYSVCW   DC    3F'0'                                                    10510422
SYSAVE DC    A(SYSQXD)                  EXIT   DISASTER                 10510423
       DC    A(SYSQXC)                  EXIT   CONTINUE                 10510424
       DC    A(SYSQXR)                  EXIT   RETRY                    10510425
       DC    A(SYSQXP)                  EXIT   OPERATOR CHOICE          10510426
       DC    A(SYSQXS)                  EXIT   START I/O FOR ADJ BACKSP 10510427
SYSTBL DC    CL16'0123456789ABCDEF'            TABLE LOOK UP FOR HEX TR 10510428
*        **********  /360 TAPE ERROR ROUTINE  **********                10510429
         DS    0D                      START PROGRAM ON DOUBLE WORD     10510430
SYSTOS   EQU   6                       EQU TO GEN REG 6                 10510431
SYSTOT   EQU   7                       EQU TO GEN REG 7                 10510432
SYSTIO   EQU   10                      EQU TO GEN REG 10                10510433
SYSTIA   EQU   11                      EQU TO GEN REG 11                10510434
SYSTOP   EQU   13                      EQU TO GEN REG 13                10510435
SYST22   DC    X'2700000140000001'     BACKSPACE CCW + CHAIN FLAG       10510436
SYST33   DC    X'1700000100000001'     ERASE GAP CCW                    10510437
SYST44   DC    X'3700000100000001'     FWD, BKSP OR NOP CCW             10510438
SYST55   CCW   X'04',SYST66,X'20',2    SENSE CCW                        10510439
SYST66   DC    H'0'                    SENSE READ IN AREA               10510440
SYSTER   TM    SYSENS,X'FF'            ANY SENSE DATA                   10510441
         BCR   8,SYSUXC                                                 10510442
         MVI   SYST44,X'27'            MODIFY CCW TO BKSP               10510443
         TM    SYSENS,X'22'            BUS OUT CHECK OR WORD COUNT ZERO 10510444
         BC    5,SYST10                                                 10510445
         BAL   SYSTIO,SYSTSE           GO TO SUB-ROUT.--EQUIP + INT REQ 10510446
         MVN   SYST44+3(1),0(SYSTIA)   GET OP CODE FROM CCW COMMAND     10510447
         NI    SYST44+3,X'07'          REMOVE MOD BIT IF RD BKWD COMMD  10510448
         TM    SYSENS,X'0C'            TEST FOR DATA OR OVERRUN CHECK   10510449
         BC    7,SYST01                                                 10510450
         TM    3(13),X'08'              TEST DATA CONVERTOR             10510451
         BZ    SYST11                   NO                              10510452
         OI    3(SYSTOP),X'08'          SET DATA CONVERTOR              10510453
       BR      SYSUXC                                                   10510454
SYST01   CLI   SYST44+3,X'04'          IS THIS A RD BKWD COMMAND        10510455
         BC    7,SYST02                NO,                              10510456
         MVI   SYST44,X'37'            YES, MODIFY CCW TO FRDSPACE      10510457
SYST02   TM    SYSENS,X'04'            IS THIS AN OVERRUN CONDITION     10510458
         BO    SYST03                  YES                              10510459
         TM  SYSENS+1,X'80'             NOISE RECORD                    10510460
         BC   1,SYSTXY                                                  10510461
         LH    7,6(11)                  PLACE ORIG CT IN 7              10510462
         SH   7,70    SUB  RESID  CT                                    10510463
         LA    6,12                                                     10510464
         CR    7,6                                                      10510465
         BCR   4,SYSUXR                 RETRY  NOISE REC IF CT LESS 12  10510466
SYSTXY   CLI   SYST44+3,X'01'          IS THIS A WRITE OPER             10510467
         BZ    SYST05                  YES                              10510468
         TM    SYSQCT,X'07'            HAS 8 ATTEMPTS BEEN TRIED        10510469
         BZ    SYST06                  YES                              10510470
         TM    SYSENS+1,X'10'          IS THIS A 7 TRACK OPER           10510471
         BO    SYST03                  YES                              10510472
         TM    SYSENS+2,X'FF'          HAS TRACK IN ERROR BEEN IDENT    10510473
         BC    7,SYST03                NO                               10510474
         BALR  SYSTIO,SYSUXS                                            10510475
         DC      Y(SYST44)                REQUEST EXECUTED              10510476
         MVI   SYST44,X'1B'            MODIFY CCW OP TO REQUEST TIE     10510477
SYST03   CLI   SYSQCT,100                                               10510478
         BC    10,SYST04               YES                              10510479
         BALR  SYSTIO,SYSUXS                                            10510480
         DC      Y(SYST44)                REQUEST EXECUTED              10510481
SYSTBS   STH   SYSTIA,SYSTDC            CCW ADDRESS IS PLACED IN RETURN 10510482
         BALR  SYSTIO,SYSUXS                                            10510483
SYSTDC   DC      Y(SYSTDC)              WITH NEW CCW                    10510484
       BR    SYSUXC                     CONTINUE                        10510485
SYST04   TM    SYSENS,X'04'            TEST FOR OVERRUN CONDITION       10510486
         BCR   1,SYSUXD                                                 10510487
         OI    3(SYSTOP),X'10'          SET UNCORRECTABLE RD ERR        10510488
         B     SYSSOF                                                   10510489
SYST05   BALR  SYSTIO,SYSUXS                                            10510490
         DC      Y(SYST22)                ERASE GAP                     10510491
         CLI   SYSQCT,4                TEST FOR 3 WRITE ATTEMPTS        10510492
         BCR   4,SYSUXR                                                 10510493
         MVI   SYSENS+1,X'F3'          INIT '3 WRITE ERRORS' MESSG.     10510494
         BR    SYSUXD                                                   10510495
SYST06   MVI   SYST44,X'27'            ROUTINE                          10510496
         LA    SYSTOS,3                 TO                              10510497
         LH    SYSTOT,SYST44+2           INCORPORATE                    10510498
SYST07   BALR  SYSTIO,SYSUXS                                            10510499
         DC      Y(SYST44)                 CLEANING                     10510500
         BALR  SYSTIO,SYSUXS                                            10510501
         DC      Y(SYST55)                   WHEN                       10510502
         TM    SYST66+1,X'08'                 EVER                      10510503
         BO    SYST08                          8                        10510504
         BCT   SYSTOS,SYST07                    READ                    10510505
SYST08   XI    SYST44,X'10'                      ERRORS                 10510506
         SR    SYSTOT,SYSTOS                      ARE                   10510507
         BCR   8,SYSUXR                                                 10510508
SYST09   BALR  SYSTIO,SYSUXS                                            10510509
         DC      Y(SYST44)                                              10510510
         BCT   SYSTOT,SYST09                                            10510511
         B     SYSTBS                  EXIT TO RETRY                    10510512
SYST10   CLI   SYSQCT,3                TEST COUNTER FOR 3 ATTEMPTS      10510513
         BCR   10,SYSUXD                                                10510514
         TM      SYSENS,X'02'           READ CT ZERO                    10510515
         BCR   1,SYSUXR                                                 10510516
         CLI   SYST44+3,X'01'          IS COMMAND A WRITE OPER          10510517
         BCR   7,SYSUXR                                                 10510518
         B     SYST03                                                   10510519
SYST11   CLI   SYST44+3,3              TEST FOR SET MODE COMMAND        10510520
         CLI   SYST44+3,3              TEST FOR SET MODE COMMAND        10510521
         BCR   8,SYSUXD                                                 10510522
         BR    SYSUXP                                                   10510523
*                                                                       10510524
SYSUXD EQU   1         REGISTER 1     DISASTER                          10510525
SYSUXC EQU   2           REGISTER 3  NO ERROR  CONTINUE                 10510526
SYSUXR EQU   3           REGISTER 3  RETRY THE LAST CCB                 10510527
SYSUXP EQU   4          GREGISTER 4   OPERATOR CHOICE                   10510528
SYSUXS EQU   5           REGISTER 5  ROUTINE FOR RESET,BACKSPACE,ETC    10510529
SYSTSE   TM      SYSENS,X'10'      EQUITMENT CHECK                      10510530
         BCR     1,SYSUXD                                               10510531
SYSTSO   TM      SYSENS,X'40'      OPERATIO INTERVENTION                10510532
         BCR     1,SYSUXP          GO TO OPERATIO  CHOICE               10510533
         BR    10                                                       10510534
***** ERROR ROUTINE FOR PRINTERS,READERS AND PUNCH FOR TAPE SYSTEM ***  10510535
SYSTSU   TM    SYSENS,X'58'                                             10510536
         BCR   5,SYSUXP                                                 10510537
SYSUBT TM    SYSENS,X'20'               BASIC TEST ROUTINE     BUSS OUT 10510538
       BC    1,SYSUIS                   BUS OUT,SWITCH FOR RETRY        10510539
       TM    SYSENS,X'80'               COMMAND REJECT                  10510540
       BCR   1,SYSUXD                   GO TO DISASTER                  10510541
       BR    10                         NONE OF THESE  RETURN TO DEV RT 10510542
***** ENTER ROUTINE HERE FOR 1402 PUNCH ERROR *****                     10510543
SYSUCC TM    SYSENS,X'10'               EQUIPMENT CHECK                 10510544
       BC    8,SYSUCD                   NO,USE 1402R ROUTINES           10510545
SYSUDA   OI    3(13),X'11'             SET BIT IN CCB                   10510546
         B     SYSSOF                   EXIT TO TEST SOFT ERR BIT       10510547
***** ENTER ROUTINE HERE FOR 1402 READER ERROR *****                    10510548
SYSUCD   NI    SYSUIS+1,X'0F'           KNOW CAN RETRY BUS OUT ON 1402  10510549
       BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10510550
SYSUDB   OI       3(13),X'08'     SET BIT IN CCB                        10510551
         BR    SYSUXC             BRANCH TO CONTINUE                    10510552
***** ENTER ROUTINE HERE IF 1403 OR 1404 ERROR *****                    10510553
SYSUCG BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10510554
       TM    SYSENS,X'02'               USUSUAL COMMAND SEQUENCE        10510555
       BC    1,SYSUDB                   USE POSTING RTN                 10510556
       OI    3(13),X'02'                SET CH 9 OVERFLOW BIT           10510557
         BC    15,SYSUDE                CONTINUE                        10510558
***** ENTER ROUTINE HERE IF 1442,2520 OR 2501 ERROR *****               10510559
SYSUAA BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10510560
         BR      SYSUXP           BRANCH TO OPERATOR CHOICE             10510561
***** ENTER ROUTINE HERE FOR 1443         ERROR *****                   10510562
*      1403  ALSO- COULD B UCG+4 * * *                                  10510563
SYSUAB   NI   SYSENS,X'F3'                                              10510564
       BAL   10,SYSTSU                   TEST EQUIP CH AND INTERV REQ   10510565
         TM    SYSENS,X'01'                                             10510566
         BCR   8,SYSUXC                                                 10510567
       OI    3(13),X'02'                SET BIT IN CCB                  10510568
         BC    15,SYSUDE                                                10510569
***** ENTER ROUTINE HERE FOR 1052 ERROR ALSO COMMON BUS-OUT ROUTINE     10510570
SYSUIS BCR   15,SYSUXP                  OPERATOR CHOICE IF COMMAND EXEC 10510571
       CLI   SYSQCT,3                   TRIED 3 TIMES                   10510572
       BCR   12,SYSUXR                  RETRRY                          10510573
       BR    SYSUXP                     OPERATIOR CHOICE                10510574
SYSSND EQU   *        ENS OF SUPERVISOR                                 10510575
*                                                                       10510576
ABSLUT     SVC   0                                                      10510577
SYSLDR EQU   ABSLUT                                                     10510578
READCD  EQU  ABSLUT                                                     10510579
           DC    YL2(CCCB)                                              10510580
       TM    CCCB+2,X'80'       WAIT FOR END                            10510581
       BZ   *-4                                                         10510582
TEXTCD     EQU   *                                                      10510583
       L     15,INPUT                  3 TESTS CHEAPER WITH REGISTER    10510584
       CL    15,CREP                                                    10510585
       BZ    REPRUT                                                     10510586
           L     14,INPUT+4              SET UP ADDRESS EITHER BR OR DA 10510587
       CL    15,CEND                                                    10510588
       BCR   8,14               END CARD, GOT TO ADDRESS                10510589
       CL    15,CTXT                                                    10510590
       BC    7,READCD                  NOT  ANDY LIGIT CZRD IGNORE IT   10510591
           LH    15,INPUT+10            COUNT                           10510592
TXTCNT  BCTR  15,0       REDUCE COUNT BY 1                              10510593
           STC   15,MOVETX+1                                            10510594
MOVETX     MVC   0(0,14),INPUT+16        MOVE DATA                      10510595
       B     READCD                                                     10510596
REPRUT TR    INPUT+6(6),SYSTBL-240      BYTE TO HEX   C1 = FA  ETC      10510597
       PACK  INPUT(5),INPUT+6(7)          ADDRESS TO HEX                10510598
       LA    14,INPUT+11                FROM ADDRESS  FIRST REPLACE     10510599
       LA    15,INPUT+16                INTO ADDRESS  FIRST REPLACE     10510600
REPLP  LA    14,5(14)                   ADD 5 TO FROM ADDRESS           10510601
       MVC   SAVE(4),0(14)              SAVE  4 BYTES                   10510602
       TR    SAVE(4),SYSTBL-240         BYTE TO HEX                     10510603
       PACK   0(3,15),SAVE(5)           PACK, DROP SIGN  ZONES          10510604
       LA    15,2(15)                   MODIFY INTO ADDR                10510605
       CLI   4(14),C','                 IS IT COMMA  LAST MUST BE BLANK 10510606
       BC    8,REPLP                    YES, MORE BYTES                 10510607
REPXT  SH    15,REPRUT+18               COUNT OF BYTES REPLACES         10510608
       L     14,INPUT                   ADDRESS OF FIRST BYTE           10510609
       B     TXTCNT                                                     10510610
SAVE   DC    X'00000000'    ROOM FOR PACK  ETC                          10510611
INPUT      DS    10D                                                    10510612
MSCCW3     DC    X'02'             READ                                 10510613
            DC   AL3(INPUT)                                             10510614
           DC    A(80)                                                  10510615
CTXT       DC    X'02E3E7E3'                                            10510616
CEND       DC    X'02C5D5C4'                                            10510617
CCCB       DC    F'0'                                                   10510618
           DC    H'4'                                                   10510619
           DC    YL2(MSCCW3)                                            10510620
CREP   DC    X'02'                                                      10510621
       DC    C'REP'                                                     10510622
JOBCT      LPSW  SYSSLB                                                 10510623
       END  JOBCT                                                       10510624
         TITLE 'JOB CONTROL'                                            10510625
NRSUP    START 0                                                        10510626
         USING *,0,4                                                    10510627
SJW4RG   EQU   1                                                        10510628
SJCCRG   EQU   2                        CARD INDEX REGISTER             10510629
SJCTRG   EQU   4                        COUNTING REGISTER               10510630
SJW1RG   EQU   5                        WORK REGISTER                   10510631
SJW2RG   EQU   6                        WORK REGISTER                   10510632
SJW3RG   EQU   7                        WORK REGISTER                   10510633
SJTBRG   EQU   8                        TABLE INDEX REGISTER            10510634
SJCRRG   EQU   9              CONTAINS ADDR OF START OF COMMUNICAT REG  10510635
SJFBRG   EQU   10                  CONTAINS ADDR OF FILL BUCKET ROUTINE 10510636
SJSBRG   EQU   11                  CONTAINS ADDR OF SKIP BLANKS ROUTINE 10510637
SJBRRG   EQU   14                       SUBROUTINE ADDR REGISTER        10510638
SJLKRG   EQU   15                       RETURN LINKAGE REGISTER         10510639
SJCRJB   EQU   38                  JOB CONTROL BYTE IN COMMUN. REGION   10510640
SJCRJC   EQU   39                  JOB CONTROL BYTE IN COMMUN. REGION   10510641
SJCRUP   EQU   23                  UPSI BYTE                            10510642
SJCRCF   EQU   9                   CONFIGURATION BYTE                   10510643
SJCRMO   EQU   0                   MONTH-2 BYTES                        10510644
SJCRDA   EQU   2                   DAY-2BYTES                           10510645
SJCRYR   EQU   4                   YEAR-5BYTES                          10510646
SJCRNM   EQU   24                  NAME-6BYTES                          10510647
SJCRUS   EQU   20                                                       10510648
         ORG   NRSUP+4096                                               10510649
START    BALR  3,0                                                      10510650
         USING *,3                                                      10510651
         LH    SJCRRG,20     SET CRREG TO ADDR OF COMM. REGION          10510652
         LA    SJFBRG,SJFLBK       INIT REG TO ADDR OF FILL BUCKET ROUT 10510653
         LA    SJSBRG,SJSKBL       INIT REG TO ADDR OF SKIP BLANKS ROUT 10510654
         MVI   SJCRUP(SJCRRG),X'00'    ZERO UPSI BYTE                   10510655
         MVC   SJEOJM+6(6),SJCRNM(SJCRRG)        PUT NAME IN EOJ MESG   10510656
         TM    SJCRJB(SJCRRG),X'02'          IS JOB FLAG ON             10510657
         BC   14,SJNEOJ                      BRANCH NOT EQUAL           10510658
         TM    SJCRJB(SJCRRG),X'80'          IS LOG FLAG ON             10510659
         BC   14,SJNEOJ                                                 10510660
         MVI   SJEOJM,C'N'                   INIT FOR NORMAL EOJ  MSG   10510661
         TM    SJCRJB(SJCRRG),X'01'          WAS JOB ABORTED            10510662
         BC   14,SJTEOJ                                                 10510663
         MVI   SJEOJM,C'A'                   INIT FOR ABNORMAL EOJ MSG  10510664
SJTEOJ   SVC   0                             WRITE EOJ MESSAGE          10510665
         DC    YL2(SJECCB)                                              10510666
         TM    SJECCB+2,X'80'                                           10510667
         BC    8,*-4                                                    10510668
SJNEOJ   NI    SJCRJB(SJCRRG),X'80'          RESET ALL BUT LOG FLAG     10510669
         MVC   SJCRUS(3,SJCRRG),SJNUMT                                  10510670
SJREAD   SR    SJCTRG,SJCTRG                                            10510671
         SR    SJW1RG,SJW1RG                                            10510672
         SR    SJW2RG,SJW2RG                                            10510673
         SR    SJW3RG,SJW3RG                                            10510674
         SR    SJW4RG,SJW4RG                                            10510675
         BAL   SJLKRG,SJRDCD                                            10510676
         CLC   SJINPT(3),SJKCTL         TEST IF CONTROL CARD            10510677
         BNE   SJNOSL                  GO TO NO SLASH ROUTINE           10510678
         BAL   SJLKRG,SJDISP                                            10510679
         LA    SJCCRG,SJINPT+2                                          10510680
         BALR  SJLKRG,SJSBRG                                            10510681
         BALR  SJLKRG,SJFBRG                                            10510682
         SR    0,0                                                      10510683
         CLI   SJBUCK+5,C' '            IS VERB GREATER THAN 5 CHAR     10510684
         BNE   SJNOCC                                                   10510685
         CLI   0(SJCCRG),C','           DID COMMA FOLLOW THE VERB       10510686
         BE    SJNOCC                                                   10510687
SJNOBR   BC    0,SJVOL1                NOP-BRANCH SWITCH                10510688
         CLC   SJBUCK(5),SJKPAU         TEST FOR PAUSE CARD             10510689
         BE    SJPAUS                                                   10510690
         CLC   SJBUCK(4),SJKJOB         TEST FOR JOB CARD               10510691
         BE    SJJOB                                                    10510692
         CLC   SJBUCK(4),SJKLOG                                         10510693
         BE    SJLOG                                                    10510694
         CLC   SJBUCK(5),SJKNLG             TEST FOR NOLOG CARD         10510695
         BE    SJNLOG                                                   10510696
         TM    SJCRJB(SJCRRG),X'02'     TEST JOB CARD FLAG              10510697
         BZ    SJNOJC                                                   10510698
         LA    SJTBRG,SJTABL       SET REG TO BEGIN OF CTL CD TABLE     10510699
SJCCLU   CLC   2(5,SJTBRG),SJBUCK       COMPARE TABLE ENTRY             10510700
         BE    SJFND                                                    10510701
         CLC   2(5,SJTBRG),SJKASG       TEST FOR END OF TABLE           10510702
         BE    SJNOCC                                                   10510703
         LA    SJTBRG,7(SJTBRG)         INCREMENT FOR NEXT TABLE ENTRY  10510704
         B     SJCCLU                   LOOP FOR NEXT TABLE ENTRY       10510705
SJFND    MVC   SJBCK1(2),0(SJTBRG)                                      10510706
         LH    SJBRRG,SJBCK1            LOAD REG WITH ROUTINE ADDR      10510707
         BR    SJBRRG                   BRANCH TO ROUTINE               10510708
SJRDCD   LA    SJCCRG,SJINPT            INIT CONTROL CARD REGISTER      10510709
         SVC   0                                                        10510710
         DC    YL2(SJCCB)                                               10510711
SJRD1    TM    SJCCB+2,X'80'                                            10510712
         BC    8,SJRD1                                                  10510713
         TM    SJCCB+3,X'04'           TEST EOF                         10510714
         BC    1,SJRDCD                YES-LET IOCS ISSUE MESSAGE       10510715
         BR    SJLKRG                                                   10510716
SJSKBL   CH    SJCCRG,SJEOC            TEST FOR END OF CARD             10510717
         BCR   10,SJLKRG                                                10510718
         CLI   1(SJCCRG),C' '          COMPARE FOR BLANK                10510719
         BNE   0(SJLKRG)                RETURN                          10510720
         LA    SJCCRG,1(SJCCRG)                                         10510721
         B     SJSKBL                                                   10510722
SJFLBK   MVC   SJBUCK,SJ9BLK           BLANK BUCKET                     10510723
         AH    0,SJK01                                                  10510724
         LA    SJW1RG,SJBUCK                                            10510725
SJFB1    CLI   1(SJCCRG),C' '           TEST FOR BLANK                  10510726
         BE    SJBKFL                                                   10510727
         CLI   1(SJCCRG),C','           TEST FOR COMMA                  10510728
         BE    SJBKFL                                                   10510729
         CH    SJCCRG,SJEOC                                             10510730
         BCR   8,SJLKRG                                                 10510731
         CH    SJW1RG,SJEOB             TEST FOR OVERFLOW OF BUCKET     10510732
         BE    SJFB2                                                    10510733
         MVC   0(1,SJW1RG),1(SJCCRG)                                    10510734
         LA    SJW1RG,1(SJW1RG)                                         10510735
SJFB2    LA    SJCCRG,1(SJCCRG)                                         10510736
         B     SJFB1                                                    10510737
SJBKFL   LA    SJCCRG,1(SJCCRG)                                         10510738
         BR    SJLKRG                                                   10510739
SJCNVB   BALR  SJLKRG,SJSBRG            SKIP BLANKS                     10510740
         BALR  SJLKRG,SJFBRG            FILL BUCKET                     10510741
         CLI   SJBUCK+8,C' '                                            10510742
         BNE   SJCCER                                                   10510743
         CLI   0(SJCCRG),C' '           DID BLANK STOP THE SCAN         10510744
         BNE   SJCCER                                                   10510745
         LH    SJCTRG,SJK008            SET COUNTER TO 8                10510746
         LA    SJTBRG,SJBUCK+7          SET REG TO END OF BUCKET ADDR   10510747
         SR    SJW2RG,SJW2RG            ZERO WORK REG                   10510748
SJCVB1   IC    SJW2RG,0(SJTBRG)         PUT ONE CHAR OF PARAM INTO REG  10510749
         CLI   0(SJTBRG),C'1'           IS CHAR A 1                     10510750
         BE    SJCVB2                                                   10510751
         SRL   SJW3RG,1                 SHIFT ODD REG INSERTING A ZERO  10510752
         B     SJCVB3                                                   10510753
SJCVB2   SRDL  SJW2RG,1            PUT A 1 IN HIGH ORDER OF ODD REG     10510754
SJCVB3   BCTR  SJTBRG,0                 SUBTRACT 1 FROM BUCKED ADDR REG 10510755
         BCT   SJCTRG,SJCVB1            LOOP 7 TIMES                    10510756
         SRL   SJW3RG,24           SHIFT HIGH BYTE TO LOW ORDER OF REG  10510757
         BR    SJBRRG                   RETURN TO CONFG OR UPSI ROUTINE 10510758
SJCONF   BAL   SJBRRG,SJCNVB            CONVERT 8 CHARS TO ONE BYTE     10510759
         STC   SJW3RG,SJCRCF(SJCRRG)         STORE CONFG BYTE IN CR     10510760
         B     SJREAD                   GET NEXT CARD                   10510761
SJUPSI   BAL   SJBRRG,SJCNVB            CONVERT 8 CHARS TO ONE BYTE     10510762
         STC   SJW3RG,SJUPSS+1         STORE CHAR IN MASK               10510763
SJUPSS   OI    SJCRUP(SJCRRG),0        OR UPSI CHAR TO UPSI BYTE        10510764
         B     SJREAD                                                   10510765
SJJOB    TM    SJCRJB(SJCRRG),X'02'          IS JOB FLAG ON             10510766
         BC    1,SJJOB1                      IF ON,GO TO ERROR          10510767
         BALR  SJLKRG,SJSBRG                 SKIP BLANKS                10510768
         BALR  SJLKRG,SJFBRG                 FILL BUCKET                10510769
         MVC   SJCRNM(6,SJCRRG),SJBUCK       MOVE NAME INTO CR          10510770
         OI    SJCRJB(SJCRRG),X'02'          SET JOB FLAG ON            10510771
         B     SJREAD                                                   10510772
SJJOB1   NI    SJCRJB(SJCRRG),X'FD'     RESET JOB CARD FLAG             10510773
         MVC   SJMESG+3(3),SJMSG1       SET UP MESSAGE FOR DOP JOB CARD 10510774
         B     SJMESG                                                   10510775
SJPAUS   TM    SJCRJB(SJCRRG),X'02'     TEST JOB CARD FLAG              10510776
         BC    8,SJPAU1                                                 10510777
         OI    SJCRJB(SJCRRG),X'04'     SET PAUSE FLAG ON               10510778
         B     SJREAD                                                   10510779
SJPAU1   MVC   SJMESG+3(3),SJPMSG       INIT PAUSE MESSAGE              10510780
         B     SJMESG                                                   10510781
SJEXEC   EQU   *                                                        10510782
         LH    SJW1RG,22     POINT REG TO SYSLST PUB                    10510783
         LA    SJW1RG,08(SJW1RG)                                        10510784
         NI    SJCRJC(SJCRRG),X'7F'    RESET PRINTER SW                 10510785
         CLI   2(SJW1RG),X'06'         IS SYSLST A PRINTER              10510786
         BE    SJSPS                                                    10510787
         CLI   2(SJW1RG),X'12'                                          10510788
         BNE   SJEXQ1                                                   10510789
SJSPS    OI    SJCRJC(SJCRRG),X'80'          SET PRINTER SW             10510790
SJEXQ1   CLI   SJCRDA(SJCRRG),X'00'     TEST IF DATE WAS SUBMITTED      10510791
         BE    SJNODC                                                   10510792
         TM    SJCRJB(SJCRRG),X'04'     TEST PAUSE FLAG                 10510793
         BC    8,SJEXQ2                                                 10510794
         SVC   2                             DELAYED PAUSE              10510795
         DC    C'1703A '                                                10510796
SJEXQ2   EQU   *                                                        10510797
SJEXQ3   LH    SJW3RG,20               GET                              10510798
         NC    SJLBKT(1),9(SJW3RG)     HIGHEST                          10510799
         LH    SJW3RG,SJKON8           CORE                             10510800
         IC    0,SJLBKT                LOCATION                         10510801
         SRL   0,5                                                      10510802
         STC   0,*+7                                                    10510803
         SLL   SJW3RG,0                                                 10510804
         BCTR  SJW3RG,0                                                 10510805
         MVI   0(SJW3RG),C'*'                                           10510806
SJLAB3   BC    0,SJMLAB                                                 10510807
SJEXQ6   CLI   19,X'00'                ARE ALL I/O FINISHED             10510808
         BNE   SJEXQ6                                                   10510809
         SVC   1                        FETCH PROGRAM                   10510810
SJEXQ4   DC    C'SYSBPD'                                                10510811
SJDATE   BALR  SJLKRG,SJSBRG            SKIP BLANKS IN CTL CARD         10510812
         BALR  SJLKRG,SJFBRG            FILL BUCKET WITH DATE           10510813
* TEST FOR NON-NUMERIC CHARACTER IN DATE FIELD                          10510814
         MVC   SJBCK1(5),SJBUCK         PUT DATE IN TEMP BUCKET         10510815
         NC    SJBCK1(5),SJK5F0         CONVERT BYTES TO XXXX0000       10510816
         CLC   SJBCK1(5),SJK5F0         TEST IF XXXX0000 ARE 11110000   10510817
         BNE   SJCCER                   IF NO THERE IS A NON NUMERIC    10510818
         MVC   SJBCK1(5),SJBUCK         PUT DATE IN TEMP BUCKET         10510819
         NC    SJBCK1(5),SJK50F         CONVERT BYTES TO 0000XXXX       10510820
         TRT   SJBCK1(5),SJNUMT         TEST IF ANY NUMBER IS NOT 0-9   10510821
         BC    6,SJCCER                                                 10510822
         CLI   SJBUCK+5,C' '       IS DATE FIELD LONGER THAN 5 CHAR     10510823
         BNE   SJCCER                                                   10510824
         CLI   SJBUCK+4,C' '            IS DATE LESS THAN 5 CHAR        10510825
         BE    SJCCER                                                   10510826
         MVC   SJCRYR(5,SJCRRG),SJBUCK       STORE 5 CHAR DATE IN CR    10510827
         PACK  SJBCK1(8),SJBUCK(2)      PACK THE YEAR                   10510828
         CVB   SJW1RG,SJBCK1            CONVERT TO BINARY THE YEAR      10510829
         MVI   SJFEB,X'1C'             SET FEB TABLE ENTRY TO 28 DAYS   10510830
         N     SJW1RG,SJKW3             AND 0003 TO TEST FOR LEAP YEAR  10510831
         BNE   SJDAT1                                                   10510832
         MVI   SJFEB,X'1D'              SET FEB TABLE ENTRY TO 29 DAYS  10510833
SJDAT1   PACK  SJBCK1(8),SJBUCK+2(3)    PACK THE DAY                    10510834
         CVB   SJW1RG,SJBCK1            CONVERT THE DAY TO BINARY       10510835
         XR    SJCTRG,SJCTRG                                            10510836
         LA    SJTBRG,SJMOTB-1     SET TABLE REGISTER TO ADDR OF MO T12 10510837
SJDAT2   LA    SJCTRG,1(SJCTRG)         ADD ONE TO MONTH COUNTER        10510838
         LA    SJTBRG,1(SJTBRG)         ADD 4 TO TABLE REG              10510839
         STC   SJW1RG,SJDAT             SAVE DATE                       10510840
         IC    SJW2RG,0(SJTBRG)                                         10510841
         SR    SJW1RG,SJW2RG            SUBTRACT MONTH VALUE FROM DATE  10510842
         BP    SJDAT2                   LOOP ON A PLUS RESULT           10510843
         CVD   SJCTRG,SJBCK1            CONVERT MONTH COUNT TO DEC      10510844
         UNPK  SJCRMO(2,SJCRRG),SJBCK1(8)         STORE MONTH IN CR     10510845
         IC    SJCTRG,SJDAT                                             10510846
         CVD   SJCTRG,SJBCK1            CONVERT DAY TO DEC              10510847
         UNPK  SJCRDA(2,SJCRRG),SJBCK1(8)         STORE DAY IN CR       10510848
         OI    SJCRMO+1(SJCRRG),X'F0'                                   10510849
         OI    SJCRDA+1(SJCRRG),X'F0'                                   10510850
         CLC   SJCRMO(2,SJCRRG),SJK12        IS MONTH MORE THAN 12      10510851
         BNH   *+14                                                     10510852
         MVC   SJCRMO(9,SJCRRG),SJNUMT       ZERO DATE FIELD            10510853
         B     SJCCER                                                   10510854
         B     SJREAD                                                   10510855
SJNODC   MVC   SJMESG+3(3),SJNDCM       SET UP MESSAGE FOR NO DATE CARD 10510856
         B     SJMESG                                                   10510857
SJSYSR   BALR  SJLKRG,SJFBRG            PUT SYS*** PARAM INTO BUCKET    10510858
         CLI   0(SJCCRG),C','           TEST FOR COMMA AFTER PARAM 1    10510859
         BNE   SJCCER                                                   10510860
         CLI   SJBUCK+6,C' '                                            10510861
         BNE   SJCCER                                                   10510862
         CLC   SJBUCK(3),SJKSYS                                         10510863
         BNE   SJCCER                                                   10510864
         LA    SJW4RG,4                 PUT DISP FOR SYSRDR IN REG      10510865
         CLC   SJBUCK+3(3),SJKRDR       TEST FOR SYSRDR                 10510866
         BCR   8,SJBRRG                 BRANCH EQUAL                    10510867
         LA    SJW4RG,4(SJW4RG)                                         10510868
         CLC   SJBUCK+3(3),SJKLST       SYSLST                          10510869
         BCR   8,SJBRRG                 BRANCH EQUAL                    10510870
         LA    SJW4RG,4(SJW4RG)                                         10510871
         CLC   SJBUCK+3(3),SJKIPT       SYSIPT                          10510872
         BCR   8,SJBRRG                 BRANCH EQUAL                    10510873
         LA    SJW4RG,4(SJW4RG)                                         10510874
         CLC   SJBUCK+3(3),SJKOPT       SYSOPT                          10510875
         BCR   8,SJBRRG                 BRANCH EQUAL                    10510876
         LA    SJW4RG,4(SJW4RG)                                         10510877
         CLC   SJBUCK+3(3),SJKLOG       SYSLOG                          10510878
         BCR   8,SJBRRG                 BRANCH EQUAL                    10510879
         CLI   SJBUCK+5,C' '                                            10510880
         BE    SJCCER                                                   10510881
         TM    SJBUCK+3,X'F0'           TEST FOR NON NUMERIC ERROR      10510882
         BC    14,SJCCER                                                10510883
         TM    SJBUCK+4,X'F0'                                           10510884
         BC    14,SJCCER                                                10510885
         TM    SJBUCK+5,X'F0'                                           10510886
         BC    14,SJCCER                                                10510887
         PACK  SJBCK1(8),SJBUCK+3(3)    PACK INTO FULL WORD             10510888
         CVB   SJW1RG,SJBCK1            CONV PUB NO TO BINARY           10510889
         LA    SJW1RG,1(SJW1RG)        ALLOW FOR PUB 000                10510890
         STC   SJW1RG,SJSYS1+1                                          10510891
         LH    SJW2RG,22                LOAD PUB ADDR IN WORK REG       10510892
SJSYS1   CLI   3(SJW2RG),X'00'          IS THIS PUB IN THIS SYSTEM      10510893
         BL    SJCCER                                                   10510894
         SLL   SJW1RG,2                 MULT PUB NO BY 4                10510895
         AR    SJW4RG,SJW1RG            ADD PUB DISP TO TABLE REG       10510896
         BR    SJBRRG                                                   10510897
SJASGN   BALR  SJLKRG,SJSBRG            SKIP BLANKS AFTER VERB          10510898
         BAL   SJBRRG,SJSYSR                                            10510899
         AH    SJW4RG,22                                                10510900
SJASG2   BAL   SJLKRG,SJFLBK                                            10510901
         XC    SJPUB(4),SJPUB                                           10510902
         CLC   SJBUCK(3),SJKUA         SHOULD PUB BE UNASSIGNED         10510903
         BE    SJASG5                  LOAD EMPTY PUB                   10510904
         CLC   SJBUCK+5(2),SJKQB        TEST IF PAR2 IS X'XXX'          10510905
         BNE   SJCCER                                                   10510906
         CLC   SJBUCK(2),SJKHEX                                         10510907
         BNE   SJCCER                                                   10510908
         CLI   SJBUCK+2,C'2'            IS CHAN GREATER THAN 2          10510909
         BH    SJCCER                                                   10510910
         MVC   SJPUB(1),SJBUCK+2        STORE CHAN IN TEMP PUB          10510911
         NI    SJPUB,X'0F'              CONV CHAN NUMBER TO BINARY      10510912
         MVC   SJBCK1(2),SJBUCK+3       PLACE HEX CHARS IN BUCKET       10510913
         BAL   SJLKRG,SJCVHB            GO TO CONV HEX TO BINARY ROUTIN 10510914
         STC   SJW2RG,SJPUB+1           STORE UNIT NO IN TEMP PUB       10510915
         BAL   SJLKRG,SJFLBK                                            10510916
         CLI   SJBUCK+2,C' '            TEST IF PARAM IS MORE THAN 2CH  10510917
         BNE   SJCCER                                                   10510918
         LA    SJTBRG,SJDTAB            SET TABLE REG TO DEVICE TAB     10510919
         LA    SJCTRG,12                                                10510920
SJASG3   CLC   SJBUCK(2),1(SJTBRG)      COMPARE TABLE ENTRY TO DEV TYPE 10510921
         BE    SJASG4                                                   10510922
         LA    SJTBRG,3(SJTBRG)         INCR TO NEXT TABLE ENTRY        10510923
         BCT   SJCTRG,SJASG3            LOOP TILL END OF TABLE          10510924
         B     SJCCER                                                   10510925
SJASG4   MVC   SJPUB+2(1),0(SJTBRG)     STORE CODE IN PUB               10510926
         CLI   0(SJCCRG),C' '           IS THERE A PARAM4               10510927
         BE    SJASG5                                                   10510928
         BALR  SJLKRG,SJFBRG            MOVE PARAM4 TO BUCKET           10510929
         CLC   SJBUCK(2),SJKHEX         TEST IF PAR4 IS X'XX'           10510930
         BNE   SJCCER                                                   10510931
         CLC   SJBUCK+4(2),SJKQB                                        10510932
         BNE   SJCCER                                                   10510933
         MVC   SJBCK1(2),SJBUCK+2       PLACE HEX CHARS IN BUCKET       10510934
         BAL   SJLKRG,SJCVHB            CONVERT HEX TO BINARY           10510935
         STC   SJW2RG,SJPUB+3           STORE ANS.IN TEMP PUB           10510936
SJASG5   MVC   0(4,SJW4RG),SJPUB        MOVE NEW ASSIGNMENT TO PUB      10510937
         B     SJREAD                                                   10510938
SJCVHB   LA    SJW1RG,SJBCK1+1          POINT REG TO 2ND HEX CHAR       10510939
         LA    SJCTRG,2                 SET COUNTER TO 2                10510940
SJCHBA   SR    SJW2RG,SJW2RG            ZERO WORK REGISTER              10510941
         IC    SJW2RG,0(SJW1RG)         PUT HEX CHAR IN WORK REG        10510942
         TM    0(SJW1RG),X'F0'          IS IT 1111XXXX                  10510943
         BC    14,SJCHB1                BRANCH IF NOT 1111XXXX          10510944
         B     SJCHB2                                                   10510945
SJCHB1   LA    SJW2RG,09(SJW2RG)                                        10510946
         CLI   0(SJW1RG),C'F'                                           10510947
         BH    SJCCER                                                   10510948
         CLI   0(SJW1RG),C'A'                                           10510949
         BL    SJCCER                                                   10510950
SJCHB2   SRDL  SJW2RG,4                 SHIFT GOOD BITS TO ADJACENT REG 10510951
         BCTR  SJW1RG,0                 POINT REG TO 1ST HEX CHAR       10510952
         BCT   SJCTRG,SJCHBA            LOOP ONCE                       10510953
         SLDL  SJW2RG,8            SHIFT BINARY BYTE TO REG FOR STC     10510954
         BR    SJLKRG                                                   10510955
SJNOJC   MVC   SJMESG+3(3),SJNJCM       MOVE MESSAGE FOR NO JOB CARD    10510956
         B     SJMESG                                                   10510957
SJNOSL   MVC   SJMESG+3(3),SJMSG3                                       10510958
         B     SJNOCC+6                                                 10510959
SJNOCC   TM    SJCRJB(SJCRRG),X'02'                                     10510960
         BZ    SJREAD                                                   10510961
         MVC   SJMESG+3(3),SJMSG2                                       10510962
         B     SJMESG                                                   10510963
SJCCER   MVI   SJMESG+3,C'3'            CONTROL CARD ERROR              10510964
         STH   0,SJMESG+4                                               10510965
         OC    SJMESG+4(2),SJK5F0                                       10510966
SJMESG   SVC   2                        TELL SUPV TO DISPLAY MESSAGE    10510967
         DC    C'1   '                  MESSAGE TO BE DISPLAYED         10510968
         DC    C'A'                    RESPONSE REQUESTED               10510969
         DC    C' '                     RESPONSE CHARACTER-NOT USED     10510970
         B     SJREAD        READ NEXT CARD                             10510971
SJLOG    TM    SJCRJB(SJCRRG),X'80'          TEST LOG FLAG              10510972
         BC    1,SJREAD                      IF ON EXIT                 10510973
         OI    SJCRJB(SJCRRG),X'80'          SET LOG FLAG ON            10510974
         BAL   SJLKRG,SJDISP                                            10510975
         B     SJREAD                                                   10510976
SJNLOG   NI    SJCRJB(SJCRRG),X'7F'          RESET LOG FLAG             10510977
         B     SJREAD                                                   10510978
SJDISP   TM    SJCRJB(SJCRRG),X'80'          TEST LOG SW                10510979
         BCR   14,SJLKRG                     EXIT IF OFF                10510980
*   SCAN CARD FROM COL 80 FOR NON-BLANK ,COMPUTE LENGTH FOR CCW         10510981
         LA    SJCCRG,SJINPT+79        COMPUTE LENGTH FOR DISPLAYING    10510982
SJDSP1   CLI   0(SJCCRG),C' '                                           10510983
         BNE   SJDSP2                                                   10510984
         BCT   SJCCRG,SJDSP1                                            10510985
SJDSP2   SH    SJCCRG,SJAIPT                                            10510986
         STH   SJCCRG,SJDCCW+6                                          10510987
         SVC   0                                                        10510988
         DC    YL2(SJDCCB)                                              10510989
         TM    SJDCCB+2,X'80'                                           10510990
         BC    8,*-4                                                    10510991
         BR    SJLKRG                                                   10510992
SJAIPT   DC    YL2(SJINPT-1)                                            10510993
SJFILE   BALR  SJLKRG,SJSBRG                                            10510994
         BAL   SJBRRG,SJSYSR                                            10510995
         STC   SJW1RG,SJTCCB+5               STORE PUB DISP IN CCB      10510996
         CLI   2(SJW2RG),X'00'               TEST FOR TAPE ASSGN IN PUB 10510997
         BNE   SJCCER                                                   10510998
         BALR  SJLKRG,SJFBRG                 GET 2ND PARAMETER          10510999
         CLC   SJBUCK(2),SJKHEX              TEST FORMAT- MUST BE X'HH' 10511000
         BNE   SJCCER                                                   10511001
         CLC   SJBUCK+4(2),SJKQB                                        10511002
         BNE   SJCCER                                                   10511003
         MVC   SJBCK1(2),SJBUCK+2            INIT FOR CONVERSION ROUT   10511004
         BAL   SJLKRG,SJCVHB                 CONVERT HEX TO BINARY      10511005
* RESULT IS IN SJW2RG.THIS WILL BE THE COUNT REG IN SKIP TAPE ROUTINE   10511006
SJSKTP   SVC   0                             SKIP TAPE TO A TAPE MARK   10511007
         DC    YL2(SJTCCB)                                              10511008
         TM    SJTCCB+2,X'80'                                           10511009
         BC    8,*-4                                                    10511010
         BCT   SJW1RG,SJSKTP                 LOOP TILL COUNT OF ZERO    10511011
         B     SJREAD                        EXIT                       10511012
SJREST   BALR  SJLKRG,SJSBRG                                            10511013
         BALR  SJLKRG,SJFBRG                 GET FIRST PARAM            10511014
         BAL   SJBRRG,SJSYSR+2               CONV SYSXXX TO A DISP      10511015
SJRS1    STH   SJW4RG,12(SJCRRG)             STORE DISP IN 2 USER BYTES 10511016
         BALR  SJLKRG,SJFBRG                 GET CHECKPOINT IDENTIFIER  10511017
         CLI   SJBUCK+4,C' '                                            10511018
         BNE   SJCCER                                                   10511019
         MVC  14(4,SJCRRG),SJBUCK            STORE IDEN IN USER BYTES   10511020
         OI    SJCRJB(SJCRRG),X'08'          SET RESTART FLAG ON        10511021
         B     SJREAD                                                   10511022
SJECCB   DC    X'002080000014'          EOJ CCB                         10511023
         DC    YL2(SJECCW)                                              10511024
SJECCW   CCW   9,SJEOJM,X'20',12                                        10511025
SJTCCB   DC    X'000010000018'         TAPE CCB                         10511026
         DC    YL2(SJTCCW)                                              10511027
SJTCCW   CCW   X'3F',SJINPT,X'20',1                                     10511028
SJDCCB   DC    X'001180000014'                                          10511029
         DC    YL2(SJDCCW)                                              10511030
SJDCCW   CCW   9,SJINPT,X'20',80                                        10511031
SJCCB    DC    X'000080000004'                                          10511032
         DC    YL2(SJCCW)                                               10511033
SJCCW    CCW   2,SJINPT,X'20',80                                        10511034
SJBCK1   DS    1CL8                                                     10511035
         DS    1CL80                                                    10511036
SJINPT   DS    1CL80                                                    10511037
SJEOB    DC    YL2(SJBUCK+9)            END OF BUCKET ADDRESS           10511038
SJEOC    DC    YL2(SJINPT+70)           END OF CARD ADDRESS             10511039
SJKW3    DC    X'00000003'                                              10511040
SJK008   DC    X'0008'                                                  10511041
SJK01    DC    X'0001'                                                  10511042
SJBUCK   DS    1CL9                                                     10511043
SJKCTL   DC    C'// '                                                   10511044
SJKPAU   DC    C'PAUSE'                                                 10511045
SJKJOB   DC    C'JOB '                                                  10511046
SJDAT    DC    C' '                                                     10511047
SJKSYS   DC    C'SYS'                                                   10511048
SJKRDR   DC    C'RDR'                                                   10511049
SJKLST   DC    C'LST'                                                   10511050
SJKIPT   DC    C'IPT'                                                   10511051
SJKOPT   DC    C'OPT'                                                   10511052
SJKLOG   DC    C'LOG '                                                  10511053
SJKNLG   DC    C'NOLOG'                                                 10511054
SJPUB    DC    C'    '                  TEMP PUB ENTRY                  10511055
SJ9BLK   DC    C'         '            9 BLANKS                         10511056
SJNJCM   DC    C'0'                     MISSING CONTROL CARD MESSAGE    10511057
         DC    C'40'                       FOR NO JOB CARD              10511058
SJNDCM   DC    C'0'                     MISSING CONTROL CARD MESSAGE    10511059
         DC    C'50'                       FOR NO DATE CARD             10511060
SJMSG1   DC    C'110'                   MESSAGE FOR DUP JOB CARDS       10511061
SJMSG2   DC    C'220'                   CONTROL CARD ERROR MESS175      10511062
SJMSG3   DC    C'200'                  ERROR MESSAGE FOR NO //          10511063
SJPMSG   DC    C'703A '                      PAUSE MESSAGE              10511064
SJDTAB   DC    X'02'                    DEVICE TABLE ENTRIES            10511065
         DC    C'C1'                                                    10511066
         DC    X'06'                                                    10511067
         DC    C'L1'                                                    10511068
         DC    X'12'                                                    10511069
         DC    C'L2'                                                    10511070
         DC    X'0A'                                                    10511071
         DC    C'P1'                                                    10511072
         DC    X'04'                                                    10511073
         DC    C'P2'                                                    10511074
         DC    X'10'                                                    10511075
         DC    C'R0'                                                    10511076
         DC    X'08'                                                    10511077
         DC    C'R1'                                                    10511078
         DC    X'0A'                                                    10511079
         DC    C'R2'                                                    10511080
         DC    X'04'                                                    10511081
         DC    C'R3'                                                    10511082
         DC    X'0E'                                                    10511083
         DC    C'S1'                                                    10511084
         DC    X'00'                                                    10511085
         DC    C'T1'                                                    10511086
         DC    X'00'                                                    10511087
         DC    C'T2'                                                    10511088
SJMOTB   DC    X'1F'                    DAYS IN MONTH TABLE             10511089
SJFEB    DC    X'1C'                                                    10511090
         DC    X'1F'                                                    10511091
         DC    X'1E'                                                    10511092
         DC    X'1F'                                                    10511093
         DC    X'1E'                                                    10511094
         DC    X'1F'                                                    10511095
         DC    X'1F'                                                    10511096
         DC    X'1E'                                                    10511097
         DC    X'1F'                                                    10511098
         DC    X'1E'                                                    10511099
         DC    X'1F'                                                    10511100
SJTABL   DC    YL2(SJDATE)              CONTROL CARD TABLE              10511101
SJKDAT   DC    C'DATE '                                                 10511102
         DC    YL2(SJCONF)                                              10511103
         DC    C'CONFG'                                                 10511104
         DC    YL2(SJVOL)                                               10511105
         DC    C'VOL  '                                                 10511106
         DC    YL2(SJFILE)                                              10511107
         DC    C'FILES'                                                 10511108
         DC    YL2(SJREST)                                              10511109
         DC    C'RSTRT'                                                 10511110
         DC    YL2(SJEXEC)                                              10511111
         DC    C'EXEC '                                                 10511112
         DC    YL2(SJUPSI)                                              10511113
         DC    C'UPSI '                                                 10511114
         DC    YL2(SJASGN)                                              10511115
SJKASG   DC    C'ASSGN'                                                 10511116
SJNUMT   DC    10X'00'                                                  10511117
         DC    C'123456'                                                10511118
SJK5F0   DC    X'F0F0F0F0F0'                                            10511119
SJK50F   DC    X'0F0F0F0F0F'                                            10511120
SJK12    DC    X'F1F2'                                                  10511121
SJKUA    DC    C'UA '                                                   10511122
SJKHEX   DC    CL2'X'''                 CONSTANT X'                     10511123
SJKQB    DC    CL2''' '                 CONSTANT QUOTE-BLANK            10511124
SJKRPG   DC    C'RPG100'                                                10511125
SJKASM   DC    C'ASSEMB'                                                10511126
SJKRES   DC    C'SYSRES'                                                10511127
SJEOJM   DC    C'N EOJ 123456'                                          10511128
*                                                                       10511129
* VOL CARD PROCESSING                                                   10511130
*                                                                       10511131
SJVOL    BALR  SJLKRG,SJSBRG    SKIP BLANKS                             10511132
         BAL   SJW3RG,SJSYSC            CONVERT AND TEST SYSXXX         10511133
         BALR  SJLKRG,SJFBRG            PUT FILE NAME IN BUCKET         10511134
         CLC   SJBUCK(7),SJ9BLK        TEST BLANK FILD                  10511135
         BE    SJLER1                                                   10511136
         MVC   SJLAB(7),SJBUCK         STORE FILE NAME IN LABEL W/A     10511137
         OI    SJNOBR+1,X'F0'                                           10511138
         B     SJREAD                                                   10511139
*       TPLAB CARD INITIAL PROCESSING                                   10511140
SJVOL1   MVI   SJLAB+7,X'00'                                            10511141
         MVC   SJLAB+8(75),SJLAB+7                                      10511142
         LA    SJW3RG,SJLAB+7                                           10511143
         OI    SJLAB3+1,X'F0'                                           10511144
         CLC   SJBUCK(5),SJTLAB         TEST FOR TPLAB CD               10511145
         BC    7,SJNOLC                 BRANCH NOT EQUAL                10511146
*                                                                       10511147
* TPLAB CARD PROCESSING                                                 10511148
*                                                                       10511149
SJTLBP   NI    SJNOBR+1,X'0F'      RESRT SJNOBR SWITCH                  10511150
         BAL   SJBRRG,SJSTRG      PROCESS STRING                        10511151
         B     SJTINU                   BRANCH POINTER FOR CONTINU CARD 10511152
         BC    8,SJLNCK                 TEST FOR 0 LENGTH STRING        10511153
SJGOMO   EX    SJW2RG,SJMOV             MOVE LABEL INFOR                10511154
* CHECK -- STRING AT LEAST 49 BYTES                                     10511155
         LA    SJW3RG,0(SJW2RG,SJW3RG)  FIND LENGTH OF STRING           10511156
SJLNCK   CH    SJW3RG,SJTMIN            TEST LENGTH OF STRING           10511157
         BC    4,SJLCER                 BRANCH NEGATINE                 10511158
         BAL   SJBRRG,SJOTD             OUTPUT LABEL REC TO DISK        10511159
         B     SJREAD                   READ NEXT CARD                  10511160
*                                                                       10511161
SJMOV    MVC   0(1,SJW3RG),0(SJW4RG)    MOVE LABEL INFOR TO OUTPUT AREA 10511162
*                                                                       10511163
SJTINU   EX    SJW2RG,SJMOV                                             10511164
         LA    SJW3RG,1(SJW2RG,SJW3RG)  INCR LABEL OUTPUT AREA FILL ADR 10511165
         BAL   SJBRRG,SJRDCN            READ CONTINUATION CARD          10511166
         BAL   SJBRRG,SJSGAG            CONTINU STRING PROCESSING       10511167
         B     SJLCER                   2ND CONTINU IS ERROR            10511168
         BC    8,SJLNCK                 TEST FOR 0 LENGTH STRING        10511169
         LA    SJBRRG,1(SJW2RG,SJW3RG)  FORM HI LAB ADDR REQUIRED       10511170
         CH    SJBRRG,SJLBHI            TEST FOR ERRONEOUSLY LONG LABEL 10511171
         BC    4,SJGOMO                 BRANCH LABEL                    10511172
         B     SJLCER                   BRANCH TO ERROR                 10511173
         USING SJLAB2,SJW3RG                                            10511174
SJOTD    LH    SJW3RG,SJLCTR+2                                          10511175
         MVC   SJLAB2(83),SJLAB                                         10511176
         LA    SJW3RG,83(SJW3RG)                                        10511177
         STH   SJW3RG,SJLCTR+2                                          10511178
         DROP  SJW3RG                                                   10511179
         BR    SJBRRG                                                   10511180
SJLCTR   DC    H'0'                                                     10511181
         DC    YL2(SJLAB2)                                              10511182
SJLBKT   DC    X'E000'                                                  10511183
SJKON8   DC    H'8192'                                                  10511184
* STRING PROCESSING ROUTINE                                             10511185
*                                                                       10511186
SJSTRG   OI    SJ2QSW+1,X'F0'           MAKE SURE SWITCH RESET          10511187
         BALR  SJLKRG,SJSBRG            SKIP BLANKS                     10511188
         MVC   SJBUCK(9),SJ9BLK         BLANK SJBUCK                    10511189
         AH    0,SJK01                                                  10511190
         CLI   1(SJCCRG),X'7D'          TEST FOR ' AT START             10511191
         BC    7,SJLCER                 BRANCH NO '                     10511192
         LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10511193
         LA    SJW4RG,1(SJCCRG)         SAVE START ADDR                 10511194
SJGOON   LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10511195
         CH    SJCCRG,SJEOC             TEST FOR END OF CARD            10511196
         BC    10,SJEOCF                BRANCH NOT NEG                  10511197
         CLI   0(SJCCRG),X'7D'          TEST FOR '                      10511198
         BC    7,SJGOON                 BRANCH NOT EQUAL                10511199
SJQUOT   CLI   1(SJCCRG),X'7D'          TEST FOR 2ND '                  10511200
         BC    7,SJDID                  BRANCH NOT EQUAL                10511201
         LR    SJW2RG,SJCCRG            MOVE CARD COL INDEX             10511202
SJMVUP   BCTR  SJW2RG,0                 DECR TEMPORARY INDEX            10511203
         MVC   1(1,SJW2RG),0(SJW2RG)    MOVE 1 CHAR UP                  10511204
         CLR   SJW4RG,SJW2RG            TEST FOR LAST CHAR              10511205
         BC    10,SJMVUP                BRANCH NOT NEG                  10511206
         LA    SJW4RG,1(SJW4RG)         INCR BEGIN ADDR                 10511207
         LA    SJCCRG,2(SJCCRG)         INCR CARD COL INDEX             10511208
         B     SJGOON                   CONTINUE SCAN                   10511209
*                                                                       10511210
SJDID    LA    SJBRRG,4(SJBRRG)         INCR RETURN PAST USER EOC BRNCH 10511211
SJNDID   LR    SJW2RG,SJCCRG            FIND LENGTH-1 OF STRING         10511212
         LA    SJCCRG,1(SJCCRG)         INCR CARD COL INDEX             10511213
         SR    SJW2RG,SJW4RG                                            10511214
         BCR   13,SJBRRG                RETURN IF LENGTH LENGTH 0       10511215
         BCTR  SJW2RG,0                                                 10511216
         BR    SJBRRG                   RETURN                          10511217
* CONTINUE SCAN ON CONTINUATION CARD                                    10511218
SJSGAG   LA    SJW4RG,1(SJCCRG)         SAVE STRING RESTART ADDR        10511219
SJ2QSW   BC    15,SJGOON                SWITCH TO NORMAL CONTINUATION   10511220
         OI    SJ2QSW+1,X'F0'           RESET SWITCH                    10511221
         B     SJQUOT                   GO TO 2ND QUOT TEST             10511222
*                                                                       10511223
SJEOCF   CLI   0(SJCCRG),X'7D'          END OF CARD OPERATIONS          10511224
         BC    7,SJNAPS                                                 10511225
         CLI   1(SJCCRG),C' '                                           10511226
         BC    8,SJDID                                                  10511227
         NI    SJ2QSW+1,X'0F'                                           10511228
         B     SJNDID                                                   10511229
*                                                                       10511230
SJNAPS   CLI   1(SJCCRG),C' '           TEST FOR CONTINUE               10511231
         BC    8,SJLCER                 BRANCH EQUAL                    10511232
SJNDEC   LR    SJW2RG,SJCCRG            FIND LENGTH-1 SO FAR            10511233
         SR    SJW2RG,SJW4RG                                            10511234
         BR    SJBRRG                                                   10511235
*                                                                       10511236
*                                                                       10511237
* READ CONTINUE CARD AND CHECK 1ST 15 COLS ARE BANK                     10511238
*                                                                       10511239
SJRDCN   BAL   SJLKRG,SJRDCD            READ CARD                       10511240
         CLI   SJINPT,C' '              TEST 1ST 15 COLS BLANK          10511241
         BNE   SJLCER                                                   10511242
         CLC   SJINPT+1(14),SJINPT                                      10511243
         BNE   SJLCER                                                   10511244
         LA    SJCCRG,SJINPT+14         LOAD CONTINUE SCAN ADDR         10511245
         BR    SJBRRG                   RETURN                          10511246
*                                                                       10511247
* SUBROUTINE -- RESET BRANCH SWITCHES                                   10511248
*                                                                       10511249
SJRRST   NI    SJNOBR+1,X'0F'        RESET NOBR SWITCHES                10511250
         BR    SJLKRG                                                   10511251
*                                                                       10511252
* NO LABEL CARD ROUTINE                                                 10511253
SJNOLC   BAL   SJLKRG,SJRRST                                            10511254
SJNLC1   NC    SJCRJB(2,SJCRRG),SJCRRS  RESET JOB CONTROL SWITCHES      10511255
         B     SJNOCC+8                 BRANCH TO NO CONTROL CARD       10511256
*ROUTINE FOR ERROR IN LABEL CARD                                        10511257
SJLCER   BAL   SJLKRG,SJRRST                                            10511258
SJLER1   NC    SJCRJB(2,SJCRRG),SJCRRS                                  10511259
         B     SJCCER                                                   10511260
* SUBROUTINE FOR SYSXXX CHECK AND CONVERSION                            10511261
SJSYSC   NI    SJNOBR+1,X'0F'   RESET SWITCHES                          10511262
         MVC   SJSAVS(2),SJCRJB(SJCRRG) SAVE JOB CONTROL BYTES          10511263
         NC    SJCRJB(2,SJCRRG),SJCRRS  RESET JOB CONTROL BYTES         10511264
         BALR  SJLKRG,SJSBRG   SKIP BLANKS                              10511265
         BAL   SJBRRG,SJSYSR   CONVERT AND CHECK                        10511266
         OI    SJNOBR+1,X'F0'     RESTORE SWITCHES                      10511267
         MVC   SJCRJB(2,SJCRRG),SJSAVS  RESTORE JOB CONTROL BYTES       10511268
         BR    SJW3RG    RETURN                                         10511269
SJMLAB   SR    SJW2RG,SJW2RG                                            10511270
         LA    SJW1RG,SJLAB2    GET WORK AREA ADD                       10511271
         LH    SJW4RG,SJLCTR+2                                          10511272
         SR    SJW4RG,SJW1RG                                            10511273
         SR    SJW3RG,SJW4RG   GET START ADD                            10511274
         MVI   0(SJW3RG),C'*'  PUT * IN FIRST POS VOL AREA              10511275
         LA    SJW3RG,1(SJW3RG)                                         10511276
SJLAB4   MVC   0(83,SJW3RG),0(SJW1RG)                                   10511277
         LA    SJW2RG,83(SJW2RG)                                        10511278
         LA    SJW1RG,83(SJW1RG)                                        10511279
         CR    SJW2RG,SJW4RG                                            10511280
         BE    SJEXQ6                                                   10511281
         LA    SJW3RG,83(SJW3RG)                                        10511282
         B     SJLAB4                                                   10511283
*  STORAGE AND CONSTANTS                                                10511284
SJLAB    DS    CL85                                                     10511285
SJTLAB   DC    CL5'TPLAB'                                               10511286
SJDECM   EQU   SJBCK1                                                   10511287
SJSAVS   DS    CL2                                                      10511288
SJTMIN   DC    YL2(SJLAB+55)                                            10511289
SJLBHI   DC    YL2(SJLAB+83)                                            10511290
SJCRRS   DC    X'8001'                                                  10511291
SJLAB2   DS    CL85                                                     10511292
         END   START                                                    10511293
         TITLE 'PHASE 1   CARD TO TAPE'                                 10511294
         START 2488                                                     10511295
STRT     BALR  15,0                                                     10511296
         USING *,15                                                     10511297
         BC    15,INPUT                                                 10511298
         ORG   *+6                                                      10511299
SORS     DC    F'1'           STARTING RECORD NUMBER                    10511300
QORS     DC    F'0'           SEQUENCING INFORMATION                    10511301
IRCLN    DC    H'80'          INPUT RECORD LENGTH                       10511302
IBKSZ    DC    H'80'          INPUT BLOCK SIZE                          10511303
ORCLN    DC    H'80'          OUTPUT RECORD LENGTH                      10511304
OBKSZ    DC    H'80'          OUTPUT BLOCK SIZE                         10511305
TPGM     DC    X'12'          PROGRAM TYPE                              10511306
TJOB     DC    X'01'          TYPE OF JOB                               10511307
FRCD     DC    X'01'          RECORD FORMAT                             10511308
DOPTN    DC    X'08'          INPUT AND OUTPUT OPTIONS                  10511309
POPTN    DC    X'00'                                                    10511310
LABSW    DC    X'00'                                                    10511311
ICU      DC    X'00'                                                    10511312
OCU      DC    X'00'                                                    10511313
IBKC     DC    F'0'                                                     10511314
OBKC     DC    F'0'                                                     10511315
LABIH    DC    C'**'                                                    10511316
LABOH    DC    C'**'                                                    10511317
LABIT    DC    H'0'                                                     10511318
LABOT    DC    X'134C'        INITIALIZED TO OUTPUT TRAILER END         10511319
LABOR    DC    H'0'                                                     10511320
AAST     DC    H'0'                                                     10511321
LABRTN   DC    X'1048'        INITIALIZED TO PHASE 4 END                10511322
IPA      DC    X'0C0C'                                                  10511323
OPA      DC    X'1010'                                                  10511324
INA      DC    H'0'                                                     10511325
INB      DC    H'0'                                                     10511326
OUTA     DC    H'0'                                                     10511327
OUTB     DC    H'0'                                                     10511328
UCLIM    DC    H'0'                                                     10511329
SWHD     DC    X'00'                                                    10511330
NOIO     DC    X'00'                                                    10511331
HEAD     DC    CL16'                '                                   10511332
         DC    CL16'                '                                   10511333
         DC    CL16'                '                                   10511334
         DC    CL16'                '                                   10511335
         DC    CL16'                '                                   10511336
         DC    CL16'                '                                   10511337
         DC    CL16'                '                                   10511338
         DC    CL16'                '                                   10511339
         DC    CL16'                '                                   10511340
DSTBL    DC    C'0123456789ABCDEF'                                      10511341
ULAB1    DC    H'0'                                                     10511342
ULAB2    DC    H'0'                                                     10511343
ULAB3    DC    H'0'                                                     10511344
ULAB4    DC    H'0'                                                     10511345
URET     DC    H'0'                                                     10511346
ULAB     DC    H'0'                                                     10511347
USW      DC    X'F0'                                                    10511348
         ORG   SORS+250                                                 10511349
*                                                                       10511350
***   CONTROL CARD INPUT                                                10511351
*                                                                       10511352
INPUT    SVC   0                                                        10511353
         DC    YL2(CCB)                                                 10511354
         TM    CCB+2,X'80'                                              10511355
         BC    8,*-4                                                    10511356
         CLC   HD1(3),CRDAR   IS CONTROL CARD                           10511357
         BC    7,LG1          NO                                        10511358
         CLI   CRDAR+3,C'U'   IS UTILITY MODIFIER CARD                  10511359
         BC    8,UTMF         YES                                       10511360
         CLC   HD2(3),CRDAR+3 IS FIELD SELECT CARD                      10511361
         BC    8,FS           YES                                       10511362
         TM    FSW,X'0F'      IS FIELD SELECT ENFORCED                  10511363
         BC    7,LG3          YES, LOG MESSAGE                          10511364
         CLC   HD3(3),CRDAR+3 IS HEADER CARD NO.1                       10511365
         BC    7,*+12         NO                                        10511366
         OI    SWHD,X'FF'     YES, SET SWHD                             10511367
         BC    15,HD                                                    10511368
         CLC   HD4(3),CRDAR+3 IS HEADER CARD NO.2                       10511369
         BC    7,*+12         NO                                        10511370
         OI    SWHD,X'FF'     YES, SET SWHD                             10511371
         BC    15,HDSD                                                  10511372
         CLC   HD5(3),CRDAR+3 IS END CARD                               10511373
         BC    7,LG6                                                    10511374
LGSW     BC    0,EOJ                                                    10511375
         SVC   1                                                        10511376
         DC    C'SYSLOD'                                                10511377
*                                                                       10511378
***   CONVERSION ROUTINE                                                10511379
*                                                                       10511380
BIN      MVC   BINC+1(1),0(6) SUPPLY ENDING CHARACTER                   10511381
         MVC   CBNN+1(1),0(6)                                           10511382
         LR    3,2            CHECK 4 DIGITS                            10511383
         LA    4,1                                                      10511384
         LA    5,3(2)                                                   10511385
         MVI   *-1,X'03'                                                10511386
LOOP     CLI   0(3),X'F0'                                               10511387
         BCR   4,8                                                      10511388
         CLI   0(3),X'F9'                                               10511389
         BCR   2,8                                                      10511390
         BXH   3,4,CBNN                                                 10511391
BINC     CLI   0(3),C','                                                10511392
         BC    8,*+14                                                   10511393
         BC    15,LOOP                                                  10511394
CBNN     CLI   0(3),C','                                                10511395
         BCR   7,8                                                      10511396
         LR    4,2                                                      10511397
         LA    2,1(3)                                                   10511398
         SR    3,4                                                      10511399
         BCTR  3,0                                                      10511400
         AH    3,N112                                                   10511401
         STC   3,*+5                                                    10511402
         PACK  TEMP(8),0(0,4) CONVERT TO BINARY                         10511403
         CVB   3,TEMP                                                   10511404
         C     3,N64K                                                   10511405
         BC    2,*+12                                                   10511406
         STH   3,0(9)                                                   10511407
         BC    15,2(6)                                                  10511408
         BCTR  2,0                                                      10511409
         BCR   15,8                                                     10511410
*                                                                       10511411
***   ERROR LOGGING ROUTINE                                             10511412
*                                                                       10511413
LG1      LA    5,MSSG1                                                  10511414
         LA    6,15                                                     10511415
         STC   6,LGMVC+1                                                10511416
         BC    15,LG                                                    10511417
LG2      LA    5,MSSG2                                                  10511418
         LA    6,38                                                     10511419
         STC   6,LGMVC+1                                                10511420
         OI    NTSW+1,X'F0'                                             10511421
         BC    15,LG                                                    10511422
LG3      LA    5,MSSG3                                                  10511423
         LA    6,24                                                     10511424
         STC   6,LGMVC+1                                                10511425
         BC    15,LG                                                    10511426
LG4      LA    5,MSSG4                                                  10511427
         LA    6,36                                                     10511428
         STC   6,LGMVC+1                                                10511429
         OI    NTSW+1,X'F0'                                             10511430
         LH    3,NOFS                                                   10511431
         AH    3,N1                                                     10511432
         STH   3,NOFS                                                   10511433
         BC    15,LG                                                    10511434
LG5      LA    5,MSSG5                                                  10511435
         LA    6,29                                                     10511436
         STC   6,LGMVC+1                                                10511437
         BC    15,LG                                                    10511438
LG6      LA    5,MSSG6                                                  10511439
         LA    6,19                                                     10511440
         STC   6,LGMVC+1                                                10511441
LG       XC    LOGAR(39),LOGAR    CLEAR PRINT AREA                      10511442
         LA    6,1(6)                                                   10511443
         STC   6,CCWL+7                                                 10511444
LGMVC    MVC   LOGAR(0),0(5)  MOVE MESSAGE TO PRINT AREA                10511445
         SVC   0             PRINT MSSG                                 10511446
         DC    YL2(CCBL)                                                10511447
         TM    CCBL+2,X'80'                                             10511448
         BC    8,*-4                                                    10511449
         OI    LGSW+1,X'F0'                                             10511450
NTSW     BC    0,NTRTN                                                  10511451
EOJ      SVC   1                                                        10511452
         DC    C'SYSEOJ'                                                10511453
NTRTN    NI    NTSW+1,X'00'                                             10511454
CKSW     BC    0,TPJOB                                                  10511455
CKSW1    BC    0,TPJBS                                                  10511456
         CLI   FSW,X'F0'                                                10511457
         BC    8,FSCK                                                   10511458
RET      LA    2,1(2)                                                   10511459
         CLI   0(2),C','                                                10511460
         BC    7,*+12                                                   10511461
         LA    2,1(2)                                                   10511462
         BC    15,SFSC+12                                               10511463
         CLI   0(2),C' '                                                10511464
         BC    7,RET                                                    10511465
         BC    15,SFS+8                                                 10511466
FSCK     LA    2,1(2)                                                   10511467
         CLI   0(2),C'/'                                                10511468
         BC    7,*+12                                                   10511469
         LA    2,1(2)                                                   10511470
         BC    15,FSIN                                                  10511471
         CLI   0(2),C' '                                                10511472
         BC    7,FSCK                                                   10511473
         BC    15,INPUT                                                 10511474
*                                                                       10511475
***   FINDING TYPE OF PROGRAM                                           10511476
*                                                                       10511477
UTMF     LA    2,CRDAR+4                                                10511478
         CLI   0(2),C' '      IS NEXT BLANK                             10511479
         BC    8,TPJBS        YES, BRANCH TO TPJBS                      10511480
         MVI   MSSG2,C'N'                                               10511481
         OI    CKSW+1,X'F0'                                             10511482
         CLI   0(2),C'C'      IS CARD INPUT                             10511483
         BC    7,*+12         NO, BRANCH TO NEXT                        10511484
         MVI   TPGM,X'10'     YES, SET TPGM                             10511485
         BC    15,OUTD                                                  10511486
         CLI   0(2),C'T'      IS TAPE INPUT                             10511487
         BC    7,*+12         NO, BRANCH TO NEXT                        10511488
         MVI   TPGM,X'20'     YES, SET TPGM                             10511489
         BC    15,OUTD                                                  10511490
         CLI   0(2),C'D'      IS DISK INPUT                             10511491
         BC    7,LG2          NO, ILLEGAL CHARACTER                     10511492
         MVI   TPGM,X'40'     YES, SET TPGM                             10511493
OUTD     CLI   1(2),C'C'      IS CARD OUTPUT                            10511494
         BC    7,*+12         NO, BRANCH TO NEXT                        10511495
         OI    TPGM,X'01'     YES, SET TPGM                             10511496
         BC    15,TPJOB                                                 10511497
         CLI   1(2),C'T'      IS TAPE OUTPUT                            10511498
         BC    7,*+12         NO, BRANCH TO NEXT                        10511499
         OI    TPGM,X'02'     YES, SET TPGM                             10511500
         BC    15,TPJOB                                                 10511501
         CLI   1(2),C'D'      IS DISK OUTPUT                            10511502
         BC    7,*+12         NO, BRANCH TO NEXT                        10511503
         OI    TPGM,X'04'     YES, SET TPGM                             10511504
         BC    15,TPJOB                                                 10511505
         CLI   1(2),C'P'      IS PRINT OUTPUT                           10511506
         BC    7,LG2          NO, ILLEGAL CHARACTER                     10511507
         OI    TPGM,X'08'     YES, SET TPGM                             10511508
*                                                                       10511509
***   FINDING TYPE OF JOB                                               10511510
*                                                                       10511511
TPJOB    NI    CKSW+1,X'00'                                             10511512
         OI    CKSW1+1,X'F0'                                            10511513
         LA    2,2(2)                                                   10511514
         CLI   0(2),C' '      IS NEXT BLANK                             10511515
         BC    7,LG2          NO, ILLEGAL FORMAT                        10511516
TPJBS    NI    CKSW1+1,X'00'                                            10511517
         MVI   MSSG2,C'T'                                               10511518
         CLI   1(2),C'T'      IS TYPE DEFINED                           10511519
         BC    7,LG2          NO, ILLEGAL FORMAT                        10511520
         MVI   MSSG2,C'J'                                               10511521
         LA    2,2(2)                                                   10511522
         CLI   0(2),C'C'      IS COPY                                   10511523
         BC    7,*+12         NO, BRANCH TO NEXT                        10511524
         MVI   TJOB,X'01'     YES, SET TJOB                             10511525
         BC    15,SFSC                                                  10511526
         CLI   0(2),C'F'      IS FIELD SELECT                           10511527
         BC    7,*+16         NO, BRANCH TO NEXT                        10511528
         MVI   TJOB,X'02'     YES, SET TJOB                             10511529
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10511530
         BC    15,SFSC                                                  10511531
         CLI   0(2),C'R'      IS REBLOCK                                10511532
         BC    7,EDD          NO, BRANCH TO NEXT                        10511533
         CLI   1(2),C'F'      IS REBLOCK AND FIELD SELECT               10511534
         BC    7,*+20         NO                                        10511535
         MVI   TJOB,X'08'     YES, SET TJOB                             10511536
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10511537
         LA    2,1(2)                                                   10511538
         BC    15,SFSC                                                  10511539
         MVI   TJOB,X'04'     SET TJOB                                  10511540
         BC    15,SFSC                                                  10511541
EDD      CLI   0(2),C'D'      IS DATA DISPLAY                           10511542
         BC    7,*+12         NO, BRANCH TO NEXT                        10511543
         MVI   TJOB,X'10'     YES, SET TJOB                             10511544
         BC    15,SFSC                                                  10511545
         CLI   0(2),C'L'      IS LIST                                   10511546
         BC    7,EB           NO, BRANCH TO EB                          10511547
         CLI   1(2),C'F'      IS LIST AND FIELD SELECT                  10511548
         BC    7,*+20         NO                                        10511549
         MVI   TJOB,X'00'     YES, SET TJOB                             10511550
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10511551
         LA    2,1(2)                                                   10511552
         BC    15,SFSC                                                  10511553
         MVI   TJOB,X'20'     SET TJOB                                  10511554
         BC    15,SFSC                                                  10511555
EB       CLI   0(2),C'B'      IS BOTH                                   10511556
         BC    7,LG2          NO, ILLEGAL FORMAT                        10511557
         CLI   1(2),C'F'      IS BOTH WITH FIELD SELECT                 10511558
         BC    7,*+20         NO                                        10511559
         MVI   TJOB,X'80'     YES, SET TJOB                             10511560
         MVI   FSW,X'FF'      SET FIELD SELECT SWITCH                   10511561
         LA    2,1(2)                                                   10511562
         BC    15,SFSC                                                  10511563
         MVI   TJOB,X'40'     SET TJOB                                  10511564
         BC    15,SFSC                                                  10511565
*                                                                       10511566
***   ENTRANCE TO SEARCH OF PARAMETERS                                  10511567
*                                                                       10511568
SFS      CLI   1(2),C' '      IS BLANK                                  10511569
         BC    7,SFSC         NO, BRANCH TO SFSC                        10511570
         BC    0,INPUT                                                  10511571
         OI    *-3,X'F0'                                                10511572
         MVI   MSSG2,C'M'                                               10511573
         CLI   REQPA,X'07'    GOT ALL REQUIRED PARAMETERS               10511574
         BC    7,LG2          NO, ILLEGAL FORMAT                        10511575
         BC    15,INPUT       YES, READ NEXT CARD                       10511576
SFSC     CLI   1(2),C','      IS COMMA                                  10511577
         BC    7,LG2          NO, ILLEGAL FORMAT                        10511578
         LA    2,2(2)                                                   10511579
*                                                                       10511580
***   RECORD FORMAT PARAMETER                                           10511581
*                                                                       10511582
         CLI   0(2),C'F'      IS FORMAT DEFINED                         10511583
         BC    7,INF          NO, BRANCH TO INF                         10511584
         NI    FRCD,X'F0'                                               10511585
         LA    2,1(2)                                                   10511586
         OI    REQPA,X'01'    YES, MODIFY REQPA                         10511587
         MVI   MSSG2,C'F'                                               10511588
         CLI   0(2),C'F'      IS F-PARAMETER                            10511589
         BC    7,*+12         NO, BRANCH TO NEXT                        10511590
         OI    FRCD,X'01'     YES, MODIFY FRCD                          10511591
         BC    15,SFS                                                   10511592
         CLI   0(2),C'V'      IS V-PARAMETER                            10511593
         BC    7,*+12         NO, BRANCH TO NEXT                        10511594
         OI    FRCD,X'02'     YES, MODIFY FRCD                          10511595
         BC    15,SFS                                                   10511596
         CLI   0(2),C'U'      IS U-PARAMETER                            10511597
         BC    7,LG2          NO, ILLEGAL FORMAT                        10511598
         OI    FRCD,X'04'     YES, MODIFY FRCD                          10511599
         BC    15,SFS                                                   10511600
*                                                                       10511601
***   A-PARAMETER                                                       10511602
*                                                                       10511603
INF      CLC   0(3,2),HD6     IS A-PARAMETER                            10511604
         BC    7,OUTF         NO, BRANCH TO OUTF                        10511605
         OI    REQPA,X'02'    YES, MODIFY REQPA                         10511606
         MVI   MSSG2,C'A'                                               10511607
         LA    2,3(2)                                                   10511608
         TM    FRCD,X'01'     IS FIXED                                  10511609
         BC    8,LICB         NO, BRANCH TO LICB                        10511610
         CLC   0(2,2),HD7     IS 'K='                                   10511611
         BC    7,ULFT         NO, BRANCH TO ULFT                        10511612
         OI    FRCD,X'10'     YES, MODIFY FRCD                          10511613
         LA    2,2(2)                                                   10511614
         LA    8,LG2          CONVERT DIGITS TO BINARY                  10511615
         LA    9,IRCLN        AND STORE IN IRCLN                        10511616
         BAL   6,BIN                                                    10511617
         DC    C', '                                                    10511618
         CLC   0(2,2),HD8     IS 'D='                                   10511619
         BC    7,LG2          NO, ILLEGAL FORMAT                        10511620
         LA    2,2(2)                                                   10511621
         BC    15,LICB                                                  10511622
ULFT     LA    8,LG2          CONVERT DIGITS TO BINARY                  10511623
         LA    9,IRCLN        AND STORE IN IRCLN                        10511624
         BAL   6,BIN                                                    10511625
         DC    C', '                                                    10511626
LICB     LA    8,LG2          CONVERT DIGITS TO BINARY                  10511627
         LA    9,IBKSZ        AND STORE IN IBKSZ                        10511628
         MVI   LOOP-5,X'04'                                             10511629
         BAL   6,BIN                                                    10511630
         DC    C') '                                                    10511631
         TM    FRCD,X'01'     IS FIXED                                  10511632
         BC    1,*+10         YES                                       10511633
         MVC   IRCLN(2),IBKSZ NO, DEFINE INPUT RECORD LENGTH            10511634
         BCTR  2,0                                                      10511635
         BC    15,SFS                                                   10511636
*                                                                       10511637
***   B-PARAMETER                                                       10511638
*                                                                       10511639
OUTF     CLC   0(3,2),HD9     IS B-PARAMETER                            10511640
         BC    7,IPAR         NO, BRANCH TO IPAR                        10511641
         OI    REQPA,X'04'    YES, MODIFY REQPA                         10511642
         MVI   MSSG2,C'B'                                               10511643
         LA    2,3(2)                                                   10511644
         TM    FRCD,X'01'     IS FIXED                                  10511645
         BC    8,LOCB         NO, BRANCH TO LOCB                        10511646
         CLC   0(2,2),HD7     IS 'K='                                   10511647
         BC    8,LCHS         YES, BRANCH TO LCHS                       10511648
         LR    3,2                                                      10511649
         LA    4,1                                                      10511650
         LA    5,3(2)                                                   10511651
LOOP1    CLI   0(3),X'F0'                                               10511652
         BC    4,LG2                                                    10511653
         CLI   0(3),X'F9'                                               10511654
         BC    2,LG2                                                    10511655
         BXH   3,4,CBNN1                                                10511656
         CLI   0(3),C','                                                10511657
         BC    8,CNQ1                                                   10511658
         CLI   0(3),C')'                                                10511659
         BC    7,LOOP1                                                  10511660
         OI    LABSW,X'01'                                              10511661
         BC    15,LOCB                                                  10511662
CBNN1    CLI   0(3),C','                                                10511663
         BC    8,CNQ1                                                   10511664
         CLI   0(3),C')'                                                10511665
         BC    7,LG2                                                    10511666
         OI    LABSW,X'01'                                              10511667
         BC    15,LOCB                                                  10511668
CNQ1     LR    5,2                                                      10511669
         LA    2,1(3)                                                   10511670
         BCTR  3,0                                                      10511671
         SR    3,5                                                      10511672
         AH    3,N112                                                   10511673
         STC   3,*+5                                                    10511674
         PACK  TEMP(8),0(0,5)                                           10511675
         CVB   3,TEMP                                                   10511676
         STH   3,ORCLN                                                  10511677
LOCB     LA    8,LG2          CONVERT DIGITS TO BINARY                  10511678
         LA    9,OBKSZ        AND STORE IN OBKSZ                        10511679
         MVI   LOOP-5,X'04'                                             10511680
         BAL   6,BIN                                                    10511681
         DC    C') '                                                    10511682
         BCTR  2,0                                                      10511683
         TM    FRCD,X'01'                                               10511684
         BC    8,*+16                                                   10511685
         TM    LABSW,X'01'                                              10511686
         BC    1,SORL                                                   10511687
         BC    15,SFS                                                   10511688
SORL     MVC   ORCLN(2),OBKSZ YES, DEFINE OUTPUT RECORD LENGTH          10511689
         BC    15,SFS                                                   10511690
LCHS     OI    FRCD,X'20'     MODIFY FRCD                               10511691
         LA    2,2(2)                                                   10511692
         LA    8,LG2          CONVERT DIGITS TO BINARY                  10511693
         LA    9,ORCLN        AND STORE IN ORCLN                        10511694
         BAL   6,BIN                                                    10511695
         DC    C', '                                                    10511696
         CLC   0(2,2),HD8     IS 'D='                                   10511697
         BC    7,LG2          NO, ILLEGAL FORMAT                        10511698
         LA    2,2(2)                                                   10511699
         BC    15,LOCB                                                  10511700
*                                                                       10511701
***   I-PARAMETER                                                       10511702
*                                                                       10511703
IPAR     CLI   0(2),C'I'      IS I-PARAMETER                            10511704
         MVI   MSSG2,C'I'                                               10511705
         BC    7,OPAR         NO, BRANCH TO OPAR                        10511706
         NI    DOPTN,X'0F'                                              10511707
         CLI   1(2),C'1'      IS '1'                                    10511708
         BC    7,*+12         NO, BRANCH TO NEXT                        10511709
         OI    DOPTN,X'00'    YES, SET DOPTN                            10511710
         BC    15,TMIP                                                  10511711
         CLI   1(2),C'2'      IS '2'                                    10511712
         BC    8,*+12         YES                                       10511713
         CLI   1(2),C'M'      IS 'M'                                    10511714
         BC    7,*+12         NO, BRANCH TO NEXT                        10511715
         OI    DOPTN,X'10'    YES, SET DOPTN                            10511716
         BC    15,TMIP                                                  10511717
         CLI   1(2),C'U'      IS 'U'                                    10511718
         BC    7,*+12         NO, BRANCH TO NEXT                        10511719
         OI    DOPTN,X'80'    YES, SET DOPTN                            10511720
         BC    15,TMIP                                                  10511721
         CLI   1(2),C'R'      IS 'R'                                    10511722
         BC    7,*+12         NO, BRANCH TO NEXT                        10511723
         OI    DOPTN,X'40'    YES, SET DOPTN                            10511724
         BC    15,TMIP                                                  10511725
         CLI   1(2),C'N'      IS 'N'                                    10511726
         BC    7,LG2          NO, ILLEGAL FORMAT                        10511727
         OI    DOPTN,X'20'    YES, SET DOPTN                            10511728
TMIP     LA    2,1(2)                                                   10511729
         BC    15,SFS                                                   10511730
*                                                                       10511731
***   O-PARAMETER                                                       10511732
*                                                                       10511733
OPAR     CLI   0(2),C'O'      IS O-PARAMETER                            10511734
         BC    7,SPAR         NO, BRANCH TO SPAR                        10511735
         MVI   MSSG2,C'O'                                               10511736
         NI    DOPTN,X'F0'                                              10511737
         CLI   1(2),C'1'      IS '1'                                    10511738
         BC    7,*+12         NO, BRANCH TO NEXT                        10511739
         OI    DOPTN,X'00'    YES, SET DOPTN                            10511740
         BC    15,TMOP                                                  10511741
         CLI   1(2),C'2'      IS '2'                                    10511742
         BC    8,*+12                                                   10511743
         CLI   1(2),C'Y'      NO, IS 'Y'                                10511744
         BC    7,*+12         NO, BRANCH TO NEXT                        10511745
         OI    DOPTN,X'01'    YES, SET DOPTN                            10511746
         BC    15,TMOP                                                  10511747
         CLI   1(2),C'U'      IS 'U'                                    10511748
         BC    8,*+12                                                   10511749
         CLI   1(2),C'C'      NO, IS 'C'                                10511750
         BC    7,*+12         NO, BRANCH TO NEXT                        10511751
         OI    DOPTN,X'08'    YES, SET DOPTN                            10511752
         BC    15,TMOP                                                  10511753
         CLI   1(2),C'R'      IS 'R'                                    10511754
         BC    8,*+12                                                   10511755
         CLI   1(2),C'X'      NO, IS 'X'                                10511756
         BC    7,*+12         NO, BRANCH TO NEXT                        10511757
         OI    DOPTN,X'04'    YES, SET DOPTN                            10511758
         BC    15,TMOP                                                  10511759
         CLI   1(2),C'N'      IS 'N'                                    10511760
         BC    7,LG2          NO, ILLEGAL FORMAT                        10511761
         OI    DOPTN,X'02'    YES, SET DOPTN                            10511762
TMOP     LA    2,1(2)                                                   10511763
         BC    15,SFS                                                   10511764
*                                                                       10511765
***   S-PARAMETER                                                       10511766
*                                                                       10511767
SPAR     CLI   0(2),C'S'      IS S-PARAMETER                            10511768
         BC    7,PPAR         NO, BRANCH TO PPAR                        10511769
         MVI   MSSG2,C'S'                                               10511770
         NI    POPTN,X'0F'                                              10511771
         CLI   1(2),C'1'      IS '1'                                    10511772
         BC    7,*+12         NO, BRANCH TO NEXT                        10511773
         OI    POPTN,X'10'    YES, SET POPTN                            10511774
         BC    15,TMSP                                                  10511775
         CLI   1(2),C'2'      IS '2'                                    10511776
         BC    7,*+12         NO, BRANCH TO NEXT                        10511777
         OI    POPTN,X'20'    YES, SET POPTN                            10511778
         BC    15,TMSP                                                  10511779
         CLI   1(2),C'3'      IS '3'                                    10511780
         BC    7,LG2          NO, ILLEGAL FORMAT                        10511781
         OI    POPTN,X'40'    YES, SET POPTN                            10511782
TMSP     LA    2,1(2)                                                   10511783
         BC    15,SFS                                                   10511784
*                                                                       10511785
***   P-PARAMETER                                                       10511786
*                                                                       10511787
PPAR     CLI   0(2),C'P'      IS P-PARAMETER                            10511788
         BC    7,RPAR         NO, BRANCH TO RPAR                        10511789
         MVI   MSSG2,C'P'                                               10511790
         NI    POPTN,X'F0'                                              10511791
         CLI   1(2),C'Y'      IS 'Y'                                    10511792
         BC    7,*+12         NO, BRANCH TO NEXT                        10511793
         OI    POPTN,X'01'    YES, SET POPTN                            10511794
         BC    15,TMPP                                                  10511795
         CLI   1(2),C'N'      IS 'N'                                    10511796
         BC    7,LG2          NO, ILLEGAL FORMAT                        10511797
         OI    POPTN,X'02'    YES, SET POPTN                            10511798
TMPP     LA    2,1(2)                                                   10511799
         BC    15,SFS                                                   10511800
*                                                                       10511801
***   R-PARAMETER                                                       10511802
*                                                                       10511803
RPAR     CLI   0(2),C'R'     IS R-PARAMETER                             10511804
         BC    7,QPAR         NO, BRANCH TO QPAR                        10511805
         MVI   MSSG2,C'R'                                               10511806
         LA    2,1(2)         CHECK DIGITS                              10511807
         LR    3,2                                                      10511808
         LA    4,1                                                      10511809
         LA    5,7(2)                                                   10511810
LP1      CLI   0(3),X'F0'                                               10511811
         BC    4,LG2                                                    10511812
         CLI   0(3),X'F9'                                               10511813
         BC    2,LG2                                                    10511814
         BXH   3,4,CBIN1                                                10511815
         CLI   0(3),C','                                                10511816
         BC    8,CBIN1+16                                               10511817
         CLI   0(3),C' '                                                10511818
         BC    7,LP1                                                    10511819
         BC    8,CBIN1+16                                               10511820
CBIN1    CLI   0(3),C','                                                10511821
         BC    8,*+12                                                   10511822
         CLI   0(3),C' '                                                10511823
         BC    7,LG2                                                    10511824
         LR    5,2            CONVERT TO BINARY AND STORE IT TO SORS    10511825
         BCTR  3,0                                                      10511826
         LR    2,3                                                      10511827
         SR    3,5                                                      10511828
         AH    3,N112                                                   10511829
         STC   3,*+5                                                    10511830
         PACK  TEMP(8),0(0,5)                                           10511831
         CVB   3,TEMP                                                   10511832
         ST    3,SORS                                                   10511833
         BC    15,SFS                                                   10511834
*                                                                       10511835
***   Q-PARAMETER                                                       10511836
*                                                                       10511837
QPAR     CLC   0(3,2),HD11    IS Q-PARAMETER                            10511838
         MVI   MSSG2,C'U'                                               10511839
         BC    7,LG2          NO, ILLEGAL FORMAT                        10511840
         MVI   MSSG2,C'Q'                                               10511841
         LA    2,3(2)         CHECK DIGITS                              10511842
         LR    3,2                                                      10511843
         LA    4,1                                                      10511844
         LA    5,1(2)                                                   10511845
LP2      CLI   0(3),X'F0'                                               10511846
         BC    4,LG2                                                    10511847
         CLI   0(3),X'F9'                                               10511848
         BC    2,LG2                                                    10511849
         BXH   3,4,CBIN2                                                10511850
         CLI   0(3),C','                                                10511851
         BC    7,LP2                                                    10511852
         BC    8,*+12                                                   10511853
CBIN2    CLI   0(3),C','                                                10511854
         BC    7,LG2                                                    10511855
         LR    5,2            CONVERT TO BINARY AND STORE IT TO QORS    10511856
         LR    2,3                                                      10511857
         BCTR  3,0                                                      10511858
         SR    3,5                                                      10511859
         AH    3,N112                                                   10511860
         STC   3,*+5                                                    10511861
         PACK  TEMP(8),0(0,5)                                           10511862
         CVB   3,TEMP                                                   10511863
         STH   3,QORS                                                   10511864
         LA    2,1(2)         CHECK DIGITS                              10511865
         LR    3,2                                                      10511866
         LA    4,1                                                      10511867
         LA    5,1(2)                                                   10511868
LP3      CLI   0(3),X'F0'                                               10511869
         BC    4,LG2                                                    10511870
         CLI   0(3),X'F9'                                               10511871
         BC    2,LG2                                                    10511872
         BXH   3,4,CBIN3                                                10511873
         CLI   0(3),C')'                                                10511874
         BC    8,CNQ                                                    10511875
         BC    7,LP3                                                    10511876
CBIN3    CLI   0(3),C')'                                                10511877
         BC    7,LG2                                                    10511878
CNQ      LR    5,2            CONVERT TO BINARY AND STORE IT TO QORS+2  10511879
         LR    2,3                                                      10511880
         BCTR  3,0                                                      10511881
         SR    3,5                                                      10511882
         AH    3,N112                                                   10511883
         STC   3,*+5                                                    10511884
         PACK  TEMP(8),0(0,5)                                           10511885
         CVB   3,TEMP                                                   10511886
         STH   3,QORS+2                                                 10511887
         BC    15,SFS                                                   10511888
*                                                                       10511889
***   ENTRANCE TO FIELD SELECT CARD                                     10511890
*                                                                       10511891
FS       TM    FSW,X'F0'      IS FIELD SELECT POSSIBLE                  10511892
         BC    8,LG5          NO, UNNECESSARY CARD                      10511893
         LA    2,CRDAR+6                                                10511894
         BC    0,FSIN                                                   10511895
         OI    *-3,X'F0'                                                10511896
         MVI   FSW,X'F0'      CLEAR ENFORCED SWITCH                     10511897
         XC    NOFS(2),NOFS   SET NOFS ZERO                             10511898
         LA    7,NOFS+2       SET REGISTER 7                            10511899
*                                                                       10511900
***   FIELD SELECT CARD                                                 10511901
*                                                                       10511902
FSIN     LH    4,NOFS                                                   10511903
         AH    4,N1                                                     10511904
         CVD   4,TEMP                                                   10511905
         UNPK  MSSG4(3),TEMP+6(2)                                       10511906
         OI    MSSG4+2,X'F0'                                            10511907
         CLC   0(3,2),HD10    IS '(K,'                                  10511908
         BC    7,INKEY        NO, BRANCH TO INKEY                       10511909
         LA    2,3(2)         YES, SET BITS                             10511910
         MVI   0(7),X'80'                                               10511911
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10511912
         LA    9,4(7)         AND STORE IN R7+4                         10511913
         BAL   6,BIN                                                    10511914
         DC    C') '                                                    10511915
         CLI   0(2),C','      IS ','                                    10511916
         BC    7,LG4          NO, ILLEGAL FORMAT                        10511917
         LA    2,1(2)                                                   10511918
         BC    15,*+22        YES                                       10511919
INKEY    MVI   0(7),X'00'                                               10511920
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10511921
         LA    9,4(7)         AND STORE IN R7+4                         10511922
         BAL   6,BIN                                                    10511923
         DC    C', '                                                    10511924
         CLI   0(2),C'('      IS '('                                    10511925
         BC    8,FLDL         YES, BRANCH TO FLDL                       10511926
         NI    0(7),X'9F'     NO, SET BITS                              10511927
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10511928
         LA    9,10(7)        AND STORE IN R7+10                        10511929
         BAL   6,BIN                                                    10511930
         DC    C', '                                                    10511931
         XC    8(2,7),8(7)                                              10511932
         BC    15,FSOUT                                                 10511933
FLDL     CLI   1(2),C'P'      IS 'P'                                    10511934
         BC    7,UCOM         NO, BRANCH TO UCOM                        10511935
         OI    0(7),X'20'     YES, SET BIT                              10511936
         BC    15,PUCOM                                                 10511937
UCOM     CLI   1(2),C'U'      IS 'U'                                    10511938
         BC    7,XCOM         NO, BRANCH TO XCOM                        10511939
         OI    0(7),X'40'     YES, SET BIT                              10511940
PUCOM    CLI   2(2),C','      IS ','                                    10511941
         BC    7,LG4          NO, ILLEGAL FORMAT                        10511942
         LA    2,3(2)                                                   10511943
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10511944
         LA    9,8(7)         AND STORE IN R7+8                         10511945
         BAL   6,BIN                                                    10511946
         DC    C', '                                                    10511947
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10511948
         LA    9,10(7)        AND STORE IN R7+10                        10511949
         BAL   6,BIN                                                    10511950
         DC    C') '                                                    10511951
         BC    15,LFSP                                                  10511952
XCOM     CLI   1(2),C'X'      IS 'X'                                    10511953
         BC    7,LG4          NO, ILLEGAL FORMAT                        10511954
         OI    0(7),X'60'     YES, SET BIT                              10511955
         CLI   2(2),C','      IS ','                                    10511956
         BC    7,LG4          NO, ILLEGAL FORMAT                        10511957
         LA    2,3(2)                                                   10511958
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10511959
         LA    9,10(7)        AND STORE IN R7+10                        10511960
         BAL   6,BIN                                                    10511961
         DC    C') '                                                    10511962
         XC    8(2,7),8(7)                                              10511963
LFSP     CLI   0(2),C','      IS ','                                    10511964
         BC    7,LG4          NO, ILLEGAL FORMAT                        10511965
         LA    2,1(2)                                                   10511966
FSOUT    CLC   0(3,2),HD10    IS '(K,'                                  10511967
         BC    7,ONKEY        NO, BRANCH TO ONKEY                       10511968
         LA    2,3(2)                                                   10511969
         OI    0(7),X'10'     YES, SET BIT                              10511970
         LA    8,LG4          CONVERT DIGITS TO BINARY                  10511971
         LA    9,6(7)         AND STORE IN R7+6                         10511972
         BAL   6,BIN                                                    10511973
         DC    C') '                                                    10511974
         BC    15,INOFS                                                 10511975
ONKEY    LR    3,2                                                      10511976
         LA    4,1                                                      10511977
         LA    5,3(2)                                                   10511978
LOP      CLI   0(3),X'F0'                                               10511979
         BC    4,LG4                                                    10511980
         CLI   0(3),X'F9'                                               10511981
         BC    2,LG4                                                    10511982
         BXH   3,4,CBN                                                  10511983
         CLI   0(3),C'/'                                                10511984
         BC    8,CBN+16                                                 10511985
         CLI   0(3),C' '                                                10511986
         BC    7,LOP                                                    10511987
         BC    8,CBN+16                                                 10511988
CBN      CLI   0(3),C'/'                                                10511989
         BC    8,*+12                                                   10511990
         CLI   0(3),C' '                                                10511991
         BC    7,LG4                                                    10511992
         LR    5,2                                                      10511993
         LR    2,3                                                      10511994
         BCTR  3,0                                                      10511995
         SR    3,5                                                      10511996
         AH    3,N112                                                   10511997
         STC   3,*+5                                                    10511998
         PACK  TEMP(8),0(0,5)                                           10511999
         CVB   3,TEMP                                                   10512000
         STH   3,6(7)                                                   10512001
INOFS    LH    3,NOFS         INCREASE NOFS BY 1                        10512002
         AH    3,N1                                                     10512003
         STH   3,NOFS                                                   10512004
         TM    0(7),X'10'     IS KEY SPECIFIED                          10512005
         AH    7,N12          INCREASE REGISTER 7 BY 12                 10512006
         BC    8,CONT         NO                                        10512007
         CLI   0(2),C'/'      IS '/'                                    10512008
         BC    7,*+12         NO                                        10512009
         LA    2,1(2)                                                   10512010
         BC    15,FSIN        YES, BRANCH TO FSIN                       10512011
         CLI   0(2),C' '      IS BLANK                                  10512012
         BC    7,LG4          NO, ILLEGAL FORMAT                        10512013
         BC    15,INPUT       YES, READ NEXT CARD                       10512014
CONT     CLI   1(2),C'/'      IS '/'                                    10512015
         BCTR  2,0                                                      10512016
         BC    7,INPUT        NO, READ NEXT CARD                        10512017
         LA    2,2(2)                                                   10512018
         BC    15,FSIN                                                  10512019
*                                                                       10512020
***   HEADER CARD                                                       10512021
*                                                                       10512022
HD       MVC   HEAD(74),CRDAR+6    STORE HEADING LINE                   10512023
         BC    15,INPUT                                                 10512024
HDSD     MVC   HEAD+74(70),CRDAR+6 STORE HEADING LINE                   10512025
         BC    15,INPUT                                                 10512026
*                                                                       10512027
***   CONSTANT                                                          10512028
*                                                                       10512029
         CNOP  0,8                                                      10512030
CCB      DC    F'0'                                                     10512031
         DC    X'0004'                                                  10512032
         DC    YL2(CCW)                                                 10512033
CCW      DC    X'02'                                                    10512034
         DC    AL3(CRDAR)                                               10512035
         DC    X'00000050'                                              10512036
CCBL     DC    F'0'                                                     10512037
         DC    X'0014'                                                  10512038
         DC    YL2(CCWL)                                                10512039
CCWL     DC    X'09'                                                    10512040
         DC    AL3(LOGAR)                                               10512041
         DC    X'00000050'                                              10512042
TEMP     DS    D                                                        10512043
N64K     DC    X'0000FFFF'                                              10512044
N1       DC    X'0001'                                                  10512045
N12      DC    X'000C'                                                  10512046
N112     DC    X'0070'                                                  10512047
CRDAR    DS    CL80                                                     10512048
         DC    C' '                                                     10512049
LOGAR    DS    CL39                                                     10512050
FSW      DC    X'00'                                                    10512051
REQPA    DC    X'00'                                                    10512052
HD1      DC    CL3'// '                                                 10512053
HD2      DC    CL3'FS '                                                 10512054
HD3      DC    CL3'H1 '                                                 10512055
HD4      DC    CL3'H2 '                                                 10512056
HD5      DC    CL3'END'                                                 10512057
HD6      DC    CL3'A=('                                                 10512058
HD7      DC    CL2'K='                                                  10512059
HD8      DC    CL2'D='                                                  10512060
HD9      DC    CL3'B=('                                                 10512061
HD10     DC    CL3'(K,'                                                 10512062
HD11     DC    CL3'Q=('                                                 10512063
MSSG1    DC    C'END CARD MISSING'                                      10512064
MSSG2    DC    C'  ILLEGAL FORMAT'                                      10512065
         DC    C'. UTILITY MODIFI'                                      10512066
         DC    C'ER CARD'                                               10512067
MSSG3    DC    C'FIELD SELECT CAR'                                      10512068
         DC    C'D MISSING'                                             10512069
MSSG4    DC    C'    ILLEGAL FORM'                                      10512070
         DC    C'AT. FIELD SELECT'                                      10512071
         DC    C' CARD'                                                 10512072
MSSG5    DC    C'FIELD SELECT CAR'                                      10512073
         DC    C'D NOT EXPECTED'                                        10512074
MSSG6    DC    C'INVALID CONTROL '                                      10512075
         DC    C'CARD'                                                  10512076
         ORG   SORS+4078                                                10512077
NOFS     DS    H                                                        10512078
         END   STRT                                                     10512079
         TITLE 'PHASE 2   CARD TO TAPE'                                 10512080
STAR     START 2752                                                     10512081
START    BALR  15,0                                                     10512082
         USING *,15                                                     10512083
*                                                                       10512084
**** CARD TO TAPE                                                       10512085
*                                                                       10512086
SORS     EQU   2500                                                     10512087
QORS     EQU   2504                                                     10512088
IRCLN    EQU   2508                                                     10512089
IBKSZ    EQU   2510                                                     10512090
ORCLN    EQU   2512                                                     10512091
OBKSZ    EQU   2514                                                     10512092
TPGM     EQU   2516                                                     10512093
TJOB     EQU   2517                                                     10512094
FRCD     EQU   2518                                                     10512095
DOPTN    EQU   2519                                                     10512096
POPTN    EQU   2520                                                     10512097
LABSW    EQU   2521                                                     10512098
ICU      EQU   2522                                                     10512099
OCU      EQU   2523                                                     10512100
IBKC     EQU   2524                                                     10512101
OBKC     EQU   2528                                                     10512102
LABIH    EQU   2532                                                     10512103
LABOH    EQU   2534                                                     10512104
LABIT    EQU   2536                                                     10512105
LABOT    EQU   2538                                                     10512106
LABOR    EQU   2540                                                     10512107
AAST     EQU   2542                                                     10512108
LABRTN   EQU   2544                                                     10512109
IPA      EQU   2546                                                     10512110
OPA      EQU   2548                                                     10512111
INA      EQU   2550                                                     10512112
INB      EQU   2552                                                     10512113
OUTA     EQU   2554                                                     10512114
OUTB     EQU   2556                                                     10512115
UCLIM    EQU   2558                                                     10512116
SWHD     EQU   2560                                                     10512117
NOIO     EQU   2561                                                     10512118
DSTBL    EQU   2706                                                     10512119
*                                                                       10512120
***      MAIN LINE DIAGNOSTIC ROUTINE                                   10512121
*                                                                       10512122
FIRSTY   LA    8,ERRTN                                                  10512123
         LA    7,ER00                  PRINT PROGRAM NAME               10512124
         BALR  14,8                                                     10512125
         LH    11,ZERO                  ZERO ERROR COUNTER              10512126
         TM    LABSW,X'01'             IS THERE A UTIL CARD ERROR       10512127
         BC    8,*+10                  NO                               10512128
         LA    7,ER3                                                    10512129
         BALR  14,8                                                     10512130
         LH    1,20                    COMMUNICATION REG ADDRESS        10512131
         SR    2,2                     ZERO REG 2                       10512132
         IC    2,9(1)                  GET CONFG BYTE                   10512133
         SRL   2,5                                                      10512134
         LH    1,ATEK                                                   10512135
         SLL   1,0(2)                  AMOUNT OF CORE AVAILABLE         10512136
         SH    1,ONE                                                    10512137
         TM    0(1),X'5C'              ASTERISK  IF YES NO LABELS       10512138
*                                                                       10512139
         BC    1,SUBT                                                   10512140
         OI    LABSW,X'20'             SET LABEL ECIST SWITCH           10512141
REPEAT   SH    1,ATEY3                 POINT TO THE NEXT LOCATI         10512142
         TM    0(1),X'5C'              IS IT AN ASTERISK                10512143
         BC    12,REPEAT                                                10512144
SUBT     STH   1,AAST                  STORE THE ASTERISK ADDRE         10512145
         STC   1,ER00                  TEST FOR HALF WORD ALIGNMENT     10512146
         TM    ER00,X'01'              IS IT ODD ALIGNMENT              10512147
         BC    8,SUBTRT                                                 10512148
         SH    1,ONE                   ALLIGN ON A  AHLF WORD BOUNDARY  10512149
SUBTRT   SH    1,TWO                   SUBT INST LENGTH                 10512150
         MVC   0(2,1),BRANCH           MOVE   BRANCH TO PHASE 4         10512151
         STH   1,UCLIM                                                  10512152
AA       TM    TPGM,X'12'               CARD TO TAPE                    10512153
         BC    1,A1                                                     10512154
         LA    7,ER0                    LOAD  ADDRESS                   10512155
         BALR  14,8                    GO TO ERROR ROUTINE              10512156
A1       LH    1,22                     REG 1 CONTAINS THE PUB ADDRESS  10512157
         CLI   14(1),X'08'             1402 CARD INPUT                  10512158
         BC    8,ZETA-4                                                 10512159
         CLI   14(1),X'04'              SYSIPT 1442,2520,2501           10512160
         BC    8,ZETA-4                                                 10512161
         LA    7,ER1                    LOAD  ADDRESS                   10512162
         BALR  14,8                    GO TO ERROR ROUTINE              10512163
         TM    3(1),X'FF'              MORE THAN 1 UNIT ASSIGNED        10512164
ZETA     BC    5,EXTRA                 FOR OUTPUT                       10512165
A2       TM    18(1),X'FF'              TAPE OUTPUT                     10512166
         BC    8,A3                                                     10512167
         LA    7,ER2                    LOAD  ADDRESS                   10512168
         BALR  14,8                    GO TO ERROR ROUTINE              10512169
A3       TM    FRCD,X'01'               FIXED LENGTH INPUT              10512170
         BC    1,A4                                                     10512171
         LA    7,ER5                    LOAD  ADDRESS                   10512172
         BALR  14,8                    GO TO ERROR ROUTINE              10512173
A4       TM    TJOB,X'0F'               TYPE C,F,RF,OR R                10512174
         BC    4,A5                                                     10512175
         OI    SWIT,X'20'              SET INVALID PROG TYPE SWIT       10512176
         LA    7,ER6                    LOAD  ADDRESS                   10512177
         BALR  14,8                    GO TO ERROR ROUTINE              10512178
A5       TM    DOPTN,X'E0'             CARD INPUT OPTION VALID          10512179
         BC    8,A6                                                     10512180
         OI    SWIT,X'02'              SUPPRESS SWITCH FOR INPUT OPTION 10512181
         LA    7,ER11                   LOAD  ADDRESS                   10512182
         BALR  14,8                    GO TO ERROR ROUTINE              10512183
A6       TM    DOPTN,X'0E'             TAPE OUTPUT OPTION VALID         10512184
         BC    4,A7                                                     10512185
         OI    SWIT,X'08'              SUPPRESS SWITCH FOR OUTPUT OPTIO 10512186
         LA    7,ER12                   LOAD  ADDRESS                   10512187
         BALR  14,8                    GO TO ERROR ROUTINE              10512188
A7       TM    DOPTN,X'10'              INPUT BINARY                    10512189
         BC    8,BCD                                                    10512190
A8       LH    1,IRCLN                  IRL GREATER THAN 160            10512191
         CH    1,ONE60                                                  10512192
         BC    13,A9                                                    10512193
         LA    7,ER7                    LOAD  ADDRESS                   10512194
         BALR  14,8                    GO TO ERROR ROUTINE              10512195
A9       LH    1,IBKSZ                  IBL GREATER THAN 160            10512196
         N     1,ANDOP                                                  10512197
         CH    1,ONE60                                                  10512198
         BC    13,OUTPUT                                                10512199
         LA    7,ER8                    LOAD  ADDRESS                   10512200
         BALR  14,8                    GO TO ERROR ROUTINE              10512201
OUTPUT   LH    1,ORCLN                  ORL GREATER THAN 4096           10512202
         CH    1,FOR096                                                 10512203
         BC    13,A10                                                   10512204
         LA    7,ER9                    LOAD  ADDRESS                   10512205
         BALR  14,8                    GO TO ERROR ROUTINE              10512206
A10      LH    3,OBKSZ                 OBL EQUAL K(ORL)                 10512207
         N     3,ANDOP                                                  10512208
         SR    2,2                     ZERO REG 2                       10512209
         LH    4,ORCLN                 PUT ORCLN IN REG Z               10512210
         DR    2,4                     DIVIDE                           10512211
         LTR   2,2                     IS THERE A REMAINDER             10512212
       BC      8,A11                                                    10512213
         LA    7,ER10                   LOAD  ADDRESS                   10512214
         BALR  14,8                    GO TO ERROR ROUTINE              10512215
A11      LH    1,QORS+2                 CARD SEQ PARA VALID             10512216
         CH    1,TEN                    6 GREATER THAN 10               10512217
         BC    13,A12                                                   10512218
         LA    7,ER13                   LOAD  ADDRESS                   10512219
         BALR  14,8                    GO TO ERROR ROUTINE              10512220
A12      AH    1,QORS                   ADD A TO B                      10512221
         SH    1,ONE                   INCLUDE THE IST POSITION SPECIFD 10512222
         CH    1,EIGHTY                                                 10512223
         BC    13,A14                                                   10512224
         LA    7,ER13                                                   10512225
         BALR  14,8                    GO TO ERROR ROUTINE              10512226
         BC    15,A14                                                   10512227
BCD      LH    1,IRCLN                  IRL GREATER THAN 80             10512228
         CH    1,EIGHTY                                                 10512229
         BC    13,A13                                                   10512230
         LA    7,ER7                                                    10512231
         BALR  14,8                    GO TO ERROR ROUTINE              10512232
A13      LH    1,IBKSZ                                                  10512233
         N     1,ANDOP                                                  10512234
         CH    1,EIGHTY                                                 10512235
         BC    13,OUTPUT                                                10512236
         LA    7,ER8                                                    10512237
         BALR  14,8                    GO TO ERROR ROUTINE              10512238
         BC    15,OUTPUT                                                10512239
A14      LH    6,IRCLN                 IF IRL NOT EQUAL ORL, THEN       10512240
         CH    6,ORCLN                 MUST FIELD SELECT                10512241
         BC    8,RP                                                     10512242
         TM    TJOB,X'0A'                                               10512243
         BC    4,RP                                                     10512244
         LA    7,ER26                                                   10512245
         BALR  14,8                                                     10512246
         BC    15,RP                                                    10512247
ERRTN    MVC   ER00(36),0(7)           MOVE MESSAGE TO PRINT AREA       10512248
         AH    11,ONE                   ADD 1 TO ERROR COUNTER          10512249
         SH    7,ONE                                                    10512250
         MVC   COM+7(1),0(7)           MOVE LENGTH TO BE PRINTED        10512251
         SVC   0                                                        10512252
         DC    YL2(CCB)                                                 10512253
         TM    CCB+2,X'80'              WRITE FINISHED                  10512254
         BC    8,*-4                                                    10512255
         BCR   15,14                                                    10512256
EXTRA    CLC   29(2,1),ZERO            IS THE UNIT ASSIGNED             10512257
         BC    8,A2                                                     10512258
         MVI   OPA+1,X'1C'             MOVE ALTERNATE OUTPUT DEVICE DSP 10512259
         TM    30(1),X'FF'                                              10512260
         BC    8,A2                                                     10512261
         LA    7,ER2                                                    10512262
         BALR  14,8                                                     10512263
         BC    15,A2                                                    10512264
*                                                                       10512265
***      MAIN LINE CONTROL                                              10512266
*                                                                       10512267
RP       LH    9,UCLIM                                                  10512268
         LH    0,ZERO                  ZERO REG ZERO                    10512269
         SR    1,1                                                      10512270
         SR    10,10                                                    10512271
RP1      TM    TJOB,X'0A'               REBLOCK AND /OR FIELD SELECT    10512272
         BC    9,REBL                                                   10512273
         LH    0,NOFS                                                   10512274
***  THIS REGISRER IS USED TO NUMBER THE FIELD SELECT ERROR MESSAGES    10512275
         LR    10,0                    GET CURRENT FS CARD ENTRY FROM   10512276
         LA    10,1(10)                ADD ONE TO REG 10                10512277
         LR    1,0                     GET THE NUMBER OF FS ENTRIES     10512278
         BCTR  1,0                                                      10512279
         MH    1,TWELVE                POINT TO THE LAST ONE            10512280
RP2      SH    0,ONE                                                    10512281
         BCTR  10,0                    POINT TO THE NEXT ENTRY          10512282
RP3      LA    7,NOFS+2(1)                                              10512283
         TM    0(7),X'60'              PACK OR UNPACK                   10512284
         BC    1,WRONG                                                  10512285
         BC    4,CC                    GO MODIFY REGS FOR DIAGNOSTICS   10512286
         MVC   ER16+32(4),ER43         MOVE FS TO ERROR MESSAGE         10512287
         MVC   ER31+4(4),ER43                                           10512288
         L     4,NOFS+10(1)                4          B                 10512289
         LR    6,4                                                      10512290
ZUTI     LH    2,NOFS+6(1)             REG 2 CONTAINS A                 10512291
         LH    3,NOFS+8(1)                  3          C                10512292
         BCTR  2,0                                                      10512293
         BCTR  3,0                                                      10512294
         LTR   4,4                     N EQUAL ZERO TEST                10512295
         BC    8,UDOPE                                                  10512296
         LR    5,2                          5          A                10512297
         LR    7,3                          7          C                10512298
         AR    5,4                          5          A+B              10512299
         AR    7,6                         7         C+B(M)             10512300
         CH    5,IRCLN                  A+B GREATER INPUT REC LENGTH    10512301
         BC    2,ERRORA                                                 10512302
         CH    7,ORCLN                  C+B         OUTPUT              10512303
         BC    2,ERRORA                                                 10512304
         LA    2,1(2)                                                   10512305
         LA    3,1(3)                                                   10512306
          LA    7,NOFS+2(1)                                             10512307
         TM    0(7),X'60'              PACK OR UNPACK                   10512308
         BC    4,BB                    GO TO PACK OR UNPACK             10512309
         BAL   14,GG                                                    10512310
         BC    15,L                                                     10512311
L        CH    0,ZERO                  ALL FIELD SELECT PATAMETERS      10512312
         BC    2,ADER                                                   10512313
Q        STH   9,UCLIM                  STORE ADDR IN UTIL COMM TAB     10512314
         TM    ICU,X'FF'               DID USER SUPPLY OWN LABELS       10512315
         BC    12,MAXIY                NO                               10512316
         SH    9,LABRTN                YES SUBT USERS LAST ADDR + 1     10512317
         MVC   CHANGE+6(2),*-2         MOVE LAST ADDR ADDRESS TO ASSGN  10512318
         BC    15,MAXY                                                  10512319
MAXIY    TM    LABSW,X'20'             IS THERE LABEL CHECKING          10512320
         BC    8,*+18                  NO                               10512321
         SH    9,LABOT                 SUBT ADDR OF PH3 OUT LABEL RTN   10512322
         MVC   CHANGE+6(2),*-2         MOVE LAST ADDR ADDRESS TO ASSGN  10512323
         BC    15,MAXY                                                  10512324
         SH    9,LABRTN                SUBT ADDR OF PHASE4              10512325
         MVC   CHANGE+6(2),*-2         MOVE LAST ADDR ADDRESS TO ASSGN  10512326
MAXY     STH   9,MAXIO                 STORE AVAILABLE CORE FOR I/O     10512327
         TM    TJOB,X'01'               TYPE COPY                       10512328
         BC    1,ASSIGN                                                 10512329
         MVI   CHANGE+1,X'80'                                           10512330
         BC    15,ASSIGN                                                10512331
ADER     SH    1,TWELVE                                                 10512332
         BC    15,RP2                                                   10512333
REBL     TM    TJOB,X'04'                                               10512334
         BC    8,Q                                                      10512335
         LH    4,IRCLN                                                  10512336
         LH    2,ONE                                                    10512337
         LH    3,ONE                                                    10512338
         BAL   14,GG                                                    10512339
         BC    15,Q                                                     10512340
ERRORA   LA    7,ER16                                                   10512341
         BAL   14,CVD                                                   10512342
         UNPK  ER16(3),OUTARA(8)                                        10512343
         BALR  14,8                    GO TO ERROR ROUTINE              10512344
         BC    15,L                                                     10512345
CC       LH    4,NOFS+10(1)            REG 4 CONTAINS N                 10512346
         LH    6,NOFS+12(1)                6          M                 10512347
         TM    0(7),X'40'                                               10512348
         BC    1,UNPKR                                                  10512349
         MVC   ER16+32(4),ER45         MOVE PACK TO ERROR MESSAGE       10512350
         MVC   ER31+4(4),ER45                                           10512351
         BC    15,ZUTI                                                  10512352
UNPKR    MVC   ER16+32(4),ER44         MOVE UNPK TO ERROR MESSAGE       10512353
         MVC   ER31+4(4),ER44                                           10512354
         BC    15,ZUTI                                                  10512355
UDOPE    LA    7,ER31                  N EQUALS ZERO                    10512356
         BAL   14,CVD                                                   10512357
         UNPK  ER31(3),OUTARA(8)                                        10512358
         BALR  14,8                                                     10512359
         BC    15,L                                                     10512360
WRONG    LA    7,ERWR                                                   10512361
         BAL    14,CVD                                                  10512362
         UNPK  ERWR(3),OUTARA(8)                                        10512363
         BALR  14,8                                                     10512364
         BC    15,L                                                     10512365
*                                                                       10512366
***    GENERATE ROUTINE FOR FIELD SELECT AND REBLOCKING                 10512367
*                                                                       10512368
GG       LH    5,TWO56                 REG 5 CONTAINS 256               10512369
         LR    7,5                          7          255              10512370
         SH    7,ONE                                                    10512371
         AH    2,XSIX                       2          A AND REG 6      10512372
         AH    3,XTEN                       3          C AND REG 10     10512373
         BCTR  2,0                                                      10512374
         BCTR  3,0                                                      10512375
BACK     CR    4,5                      B LESS OR EQUAL TO 256          10512376
         BC    12,LAST                                                  10512377
         STH   2,MOVE+4                 NO - STORE A AND C              10512378
         STH   3,MOVE+2                                                 10512379
         AR    2,5                      ADD 256 TO A AND C              10512380
         AR    3,5                                                      10512381
         STC   7,MOVE+1                 STORE 255 IN DUMMY INST         10512382
         SR    4,5                      SUBT  256 FROM B                10512383
         SH    9,SIX                   SUBT INST LENGTH                 10512384
         MVC   0(6,9),MOVE             MOVE INST TO UPPER CORE          10512385
         BC    15,BACK                                                  10512386
LAST     STH   2,MOVE+4                GENERATE LAST MOVE               10512387
         STH   3,MOVE+2                                                 10512388
         SH    4,ONE                   SUBT ONE FROM B                  10512389
         STC   4,MOVE+1                                                 10512390
         SH    9,SIX                   SUBT INST LENGTH                 10512391
         MVC   0(6,9),MOVE             MOVE INST TO UPPER CORE          10512392
         BCR   15,14                    RETURN                          10512393
*                                                                       10512394
***      UNPACK ROUTINE                                                 10512395
*                                                                       10512396
Z        LH    2,NOFS+6(1)              REG 2 CONTAINS A                10512397
         LH    3,NOFS+8(1)                  3          C                10512398
         LH    4,NOFS+10(1)                 4          N                10512399
         LH    5,NOFS+12(1)                 5          M                10512400
         AH    2,XSIX                       2          A AND REG 6      10512401
         AH    3,XTEN                       3          C AND REG 10     10512402
         SH    2,ONE                     SUBT 1,1 FROM A,C              10512403
         SH    3,ONE                                                    10512404
         STH   2,UNPK2+4                 STORE A,C IN UNPACK2           10512405
         STH   3,UNPK2+2                                                10512406
         STH   3,MVI+2                                                  10512407
         STH   3,MVC+4                                                  10512408
         AH    3,ONE                                                    10512409
         STH   3,MVC+2                                                  10512410
         SH    3,ONE                                                    10512411
         CH    4,EIGHT                  N LESS OR EQUAL TO 8            10512412
         BC    12,LES                                                   10512413
         AR    2,4                      A AND C NOW POINT TO THE LAST   10512414
         AR    3,5                      BYTE +1 OF THEIR AREAS          10512415
         SH    2,ONE                     SUBT 1,1 FROM A,C              10512416
         SH    3,ONE                                                    10512417
ALPHA    CH    4,EIGHT                  N LESS OR EQUAL TO 8            10512418
         BC    12,LES                                                   10512419
         SH    2,SEVEN                                                  10512420
         SH    3,FORTEN                  SUBT 7,14 FROM A,C , N,M       10512421
         SH    4,SEVEN                                                  10512422
         SH    5,FORTEN                                                 10512423
         STH   2,UNPK1+4                                                10512424
         STH   3,UNPK1+2                                                10512425
         SH    9,SIX                    MOVE TO                         10512426
         MVC   0(6,9),UNPK1             UPPER CORE                      10512427
         BC    15,ALPHA                                                 10512428
LES      CH    5,ONE                   M LESS THAN ONE                  10512429
         BC    4,ERRO                                                   10512430
         CH    5,SIXTEN                M GREATER THAN 16                10512431
         BC    12,GEBER1                                                10512432
         CH    5,TWO56                 M GREATER THAN 256               10512433
         BC    2,ERRO                                                   10512434
         SH    5,ONE                   SUBT ONE FROM M                  10512435
         STC   5,MVC+1                   STORE LENGTH                   10512436
         SH    3,FORTEN                  SUBT 14 FROM C                 10512437
         STH   3,UNPK2+2               STORE C AND REGS IN INST         10512438
         SH    4,ONE                   SUBT ONE FROM N                  10512439
         STC   4,UNPK2+1                 STORE N                        10512440
         MVZ   UNPK2+1(1),UNPK1+1      STORE M IN LENGTH                10512441
         SH    9,SIXTEN                  SUBT INST LENGTH               10512442
         MVC   0(16,9),MVI               MOVE TO UPPER CORE             10512443
         STH   9,UCLIM                 STORE UPPER CORE LIMIT           10512444
         BC    15,L                                                     10512445
GEBER1   SH    4,ONE                   SUBT ONE FROM(N,M)               10512446
         SH    5,ONE                                                    10512447
ASTER    SLA   5,4                      GET ONE BYTE LENGTH MIN         10512448
         AR    5,4                                                      10512449
         STC   5,UNPK2+1                LENGTH IS STORED                10512450
         SH    9,SIX                                                    10512451
         MVC   0(6,9),UNPK2                                             10512452
         BC    15,L                                                     10512453
*                                                                       10512454
***      PACK ROUTINE                                                   10512455
*                                                                       10512456
BB       LA    7,NOFS+2(1)             MOVE ADDRESS OF TYPE INTO REG 7  10512457
         TM    0(7),X'20'              IS IT PACK                       10512458
         BC    8,Z                                                      10512459
         LH    2,NOFS+6(1)              REG 2 CONTAINS A                10512460
         LH    3,NOFS+8(1)                  3          C                10512461
         LH    4,NOFS+10(1)                 4          N                10512462
         LH    5,NOFS+12(1)                 5          M                10512463
         AH    2,XSIX                       2          A AND REG 6      10512464
         AH    3,XTEN                       3          C         10     10512465
         SH    2,ONE                   SUBT 1,1 FROM A,C                10512466
         SH    3,ONE                                                    10512467
         STH   2,PACK2+4               STORE A AND REGS IN PACK         10512468
         STH   3,PACK2+2                                                10512469
         STH   3,XCL+2                 STORE C AND REGS IN PACK AND XC  10512470
         STH   3,XCL+4                                                  10512471
         CH    4,SIXTEN                 N LESS OR EQUAL TO 16           10512472
         BC    12,LES2                                                  10512473
         AR    2,4                     ADD N-1,M-1 TO A,C               10512474
         AR    3,5                                                      10512475
         SH    2,ONE                   SUBT U,1 FROM A,C                10512476
         SH    3,ONE                                                    10512477
BETA     CH    4,SIXTEN                 N LESS OR EQUAL TO 16           10512478
         BC    12,LES2                                                  10512479
         SH    2,FORTEN                SUBT 14,7 FROM A,C               10512480
         SH    3,SEVEN                                                  10512481
         STH   2,PACK1+4               A AND C IN INSTRUCTION           10512482
         STH   3,PACK1+2                                                10512483
         SH    4,FORTEN                 SUBT(14,7) FROM (A,C)AND (N,M)  10512484
         SH    5,SEVEN                                                  10512485
         SH    9,SIX                    SUBT INST LENGTH                10512486
         MVC   0(6,9),PACK1            MOVE TO UPPER CORE               10512487
         BC    15,BETA                                                  10512488
LES2     CH    5,ONE                   M LESS THAN 2                    10512489
         BC    4,ERRO1                                                  10512490
         CH    5,SIXTEN                M GREZTER THAN 16                10512491
         BC    12,GEBER                                                 10512492
         CH    5,TWO56                 M GREATER THAN 256               10512493
         BC    2,ERRO1                                                  10512494
         SH    5,ONE                   SUBT ONE FROM M                  10512495
         STC   5,XCL+1                 STORE LENGTH IN EXCLUSIVE OR     10512496
         SH    3,FORTEN                SUBT 14 FROM C AND REGS          10512497
         STH   3,PACK2+2                                                10512498
         SH    4,ONE                   SUBT ONE FROM N                  10512499
         STC   4,PACK2+1               STORE N-1                        10512500
         MVZ   PACK2+1(1),KONST        PUT 15 UN INST LENGTH            10512501
         SH    9,TWELVE                SUBT INST LENGTH                 10512502
         MVC   0(12,9),XCL             MOVE INSTRUCTIONS TO UPPER CORE  10512503
         BC    15,L                                                     10512504
GEBER    SH    4,ONE                   SUBT 1,1 FROM N,M                10512505
         SH    5,ONE                    GET 1 BYTE LENGTH               10512506
         SLA   5,4                      AND                             10512507
         AR    5,4                      STORE                           10512508
         STC   5,PACK2+1                                                10512509
         SH    9,SIX                   SUBT INST LENGTH                 10512510
         MVC   0(6,9),PACK2            MOVE TO UPPER COE                10512511
         BC    15,L                                                     10512512
*                                                                       10512513
***      ASSIGN I/O AREAS                                               10512514
*                                                                       10512515
ASSIGN   OI    SWIT,X'01'                                               10512516
         TM    TJOB,X'01'              JOB COPY                         10512517
         BC    8,COPYER                                                 10512518
         CLC   IBKSZ(2),OBKSZ          BLOCK SIZES EQUAL                10512519
         BC    8,COPYER                                                 10512520
         OI    SWIT,X'04'              SUPRESS I/O PRINT SWITCH         10512521
         LA    7,ER10                  INVALID OUTPUT BLOCK LENGTH      10512522
         BALR  14,8                                                     10512523
         BC    15,GOERT                                                 10512524
COPYER   EQU   *                                                        10512525
         LH    2,TWO                                                    10512526
         LH    1,MAXIO                 A EQUALS 2,IO LIMIT IS IN REG 1  10512527
         N     1,ANDOP                 GET RID OF MINUS PROROGATION     10512528
         LH    10,OBKSZ                                                 10512529
         LH    9,IBKSZ                 GET INKSZ IN REG 9               10512530
         N     10,ANDOP                                                 10512531
         N     9,ANDOP                 GET RID OF MINUS                 10512532
         LR    3,2                          B=2                         10512533
RETURN   LR    7,3                                                      10512534
         LR    5,2                                                      10512535
         MR    6,10                                                     10512536
         MR    4,9                                                      10512537
         AR    5,7                                                      10512538
         CR    5,1                                                      10512539
         BC    12,ASGN                 ASSIGN AREAS IF POSSIBLE         10512540
TEST     TM    SWIT,X'01'                   SWITCH ON TEST              10512541
         BC    1,ON                                                     10512542
         OI    SWIT,X'01'                   TURN SWITCH ON              10512543
         SH    2,ONE                        SUBT ONE FROM A             10512544
         AH    3,ONE                        ADD ONE TO B                10512545
         LTR   2,2                          A LESS THAN ZERO            10512546
         BC    4,ERROR                      YES                         10512547
         BC    15,RETURN                    NO                          10512548
ON       NI    SWIT,X'FE'                   TURN SWITCH OFF             10512549
         SH    3,ONE                        SUBT ONE FROM B             10512550
         BC    15,RETURN                                                10512551
ERROR    LA    8,ERRTN                                                  10512552
         LA    7,ER14                   LOAD  ADDRESS                   10512553
         OI    SWIT,X'04'              SET SUPRESS I/O PRINT SWITCH     10512554
         BALR  14,8                    GO TO ERROR ROUTINE              10512555
GOERT    STH   11,FOR096               STORE NUMBER OF ERRORS           10512556
         BC    15,ENDLOG                                                10512557
*                                                                       10512558
***   ACTUAL ASSIGNING OF INPUT OUTPUT AREAS                            10512559
*                                                                       10512560
ASGN     LTR   2,2                                                      10512561
CHANGE   BC    6,TEST                  IF TYPE COPY, BC6, IF NOT BC8    10512562
         LH    6,ZERO                  THIS ADDRESS IS MODIFIED         10512563
         BC    8,STOR3                 IF ZERO, A = 0                   10512564
         STH   6,INA                   STORE ASDRESS IN INA             10512565
         SH    2,ONE                   SUBT ONE FROM A                  10512566
         LTR   2,2                     TEST FOR A ' ZERO                10512567
         BC    8,STOR                                                   10512568
         AR    6,9                                                      10512569
STOR     STH   6,INB                   STOR ADDRESS IN INB              10512570
         LTR   3,3                     B = 0 TEST                       10512571
         BC    8,STOR2                                                  10512572
         AR    6,9                                                      10512573
         STH   6,OUTA                                                   10512574
         SH    3,ONE                                                    10512575
         LTR   3,3                     B = 0 TEST                       10512576
         BC    8,STOR1                                                  10512577
         AR    6,10                                                     10512578
STOR1    STH   6,OUTB                  STORE ADDRESS IN OUT B           10512579
         BC    15,LOG                                                   10512580
STOR2    MVC   INA(2),OUTA             COMBINED I/O AREAS               10512581
         MVC   INB(2),OUTB             MAKE IN AND OUT CORRESPOND       10512582
         BC    15,LOG                                                   10512583
STOR3    STH   6,INA                   STORE ADDRESS IN                 10512584
         STH   6,OUTA                  INA AND POUT A                   10512585
         SH    3,ONE                                                    10512586
         LTR   3,3                                                      10512587
         BC    8,STOR4                 B = 0 TEST                       10512588
         AR    6,10                                                     10512589
STOR4    STH   6,INB                                                    10512590
         STH   6,OUTB                                                   10512591
LOG      SR    7,7                     CLEAR REG 7 TO ZERO              10512592
         CLC   INA(2),INB                                               10512593
         BC     8,*+8                  /NA EQUAL INB  ADD ONLY 16       10512594
         AH    7,SIXTEN                                                 10512595
         AH    7,SIXTEN                                                 10512596
         CLC    OUTA(2),OUTB                                            10512597
         BC    8,*+8                   OUTA EQUAL OUTB  ADD ONLY 1      10512598
         AH     7,ONE                                                   10512599
         AH     7,ONE                                                   10512600
         STC    7,NOIO                                                  10512601
         BC    15,GOERT                                                 10512602
*                                                                       10512603
***      LOG JOB ROUTINE                                                10512604
*                                                                       10512605
ENDLOG   LH    6,IRCLN                                                  10512606
         MVI   CVD+1,X'60'             CHANGE THE REGISTER IN THE CVD   10512607
         TM    FRCD,X'06'              VARIABLE OR UNDEFINED PROCESSING 10512608
         BC    4,*+20                  BYPASS RECORD FORMAT PRINT       10512609
         BAL   14,CVD                                                   10512610
         UNPK  ER18+20(4),OUTARA(8)                                     10512611
         LA    7,ER18                                                   10512612
         BALR  14,8                    GO TO ERROR ROUTINE              10512613
         LH    6,IBKSZ                                                  10512614
         N     6,ANDOP                 GET RID OF MINUS PROPOGATION     10512615
         BAL   14,CVD                                                   10512616
         UNPK  ER19+17(5),OUTARA(8)          IBKSZ                      10512617
         LA    7,ER19                                                   10512618
         BALR  14,8                    GO TO ERROR ROUTINE              10512619
         TM    FRCD,X'06'              VARIABLE OR UNDEFINED PROCESSING 10512620
         BC    4,*+24                  BYPASS RECORD FORMAT PRINT       10512621
         LH    6,ORCLN                                                  10512622
         BAL   14,CVD                                                   10512623
         UNPK  ER20+22(4),OUTARA(8)                                     10512624
         LA    7,ER20                                                   10512625
         BALR  14,8                    GO TO ERROR ROUTINE              10512626
         LH    6,OBKSZ                                                  10512627
         N     6,ANDOP                 GET RID OF MINUS PROPOGATION     10512628
         BAL   14,CVD                                                   10512629
         UNPK  ER21+18(5),OUTARA(8)      OBKSZ                          10512630
         LA    7,ER21                                                   10512631
         BALR  14,8                    GO TO ERROR ROUTINE              10512632
         TM    SWIT,X'02'              INVALID INPUT OPTION             10512633
         BC    1,A999                                                   10512634
         TM    DOPTN,X'10'              INPUT OPTION                    10512635
         BC    8,BCD1                                                   10512636
         MVC   ER22+13(11),ER47         CARD BINARY                     10512637
OUTOPT   LA    7,ER22                                                   10512638
         BALR  14,8                    GO TO ERROR ROUTINE              10512639
A999     TM    SWIT,X'08'              INVALID OUTPUT OPTION            10512640
         BC    1,RETUNR+6                                               10512641
         TM    DOPTN,X'02'              OUTPUT OPTION                   10512642
         BC    1,OPTOPT                 TAPE NEITHER                    10512643
         TM    DOPTN,X'04'                                              10512644
         BC    1,OPTTOP                 TAPE REWIND                     10512645
         MVC   ER23+14(18),ER50                                         10512646
RETUNR   LA    7,ER23                                                   10512647
         BALR  14,8                    GO TO ERROR ROUTINE              10512648
         TM    SWIT,X'04'              TEST SUPRESS I/O PRINT SWITCH    10512649
         BC    1,LOADZ+6                                                10512650
         TM    TJOB,X'01'              COPY TEST                        10512651
         BC    1,MUV                                                    10512652
         TM    NOIO,X'02'               2 OUTPUT                        10512653
         BC    1,STORTO                                                 10512654
         MVI   ER24+8,X'F1'            PUT 1 IN OUTPUT                  10512655
ZERT     TM    NOIO,X'20'               2 INPUT                         10512656
         BC    1,STORTT                                                 10512657
         MVI   ER24,X'F1'              PUT 1 IN INPUT                   10512658
LOADZ    LA    7,ER24                                                   10512659
         BALR  14,8                    GO TO ERROR ROUTINE              10512660
         TM    FRCD,X'01'              FIXED INPUT                      10512661
         BC    1,FIXED                                                  10512662
         TM    FRCD,X'02'              VARIABLE INPUT                   10512663
         BC    1,VAR                                                    10512664
         MVC   ER32+14(9),ER40         MOVE UNDEFINED TO MESSAGE        10512665
LO       LA    7,ER32                                                   10512666
         BALR  14,8                                                     10512667
         TM    SWIT,X'20'              INVALID PROGRAM TYPE             10512668
         BC    1,WRITE+6                                                10512669
         TM    TJOB,X'01'              TYPE COPY                        10512670
         BC    8,*+14                                                   10512671
         MVC   ER33+5(4),ER39A                                          10512672
         BC    15,WRITE                                                 10512673
         TM    TJOB,X'02'              FIELD SELECT                     10512674
         BC    8,*+14                                                   10512675
         MVC   ER33+5(12),ER39B                                         10512676
         BC    15,WRITE                                                 10512677
         TM    TJOB,X'04'              REBLOCK                          10512678
         BC    8,*+14                                                   10512679
         MVC   ER33+5(7),ER39C                                          10512680
         BC    15,WRITE                                                 10512681
         MVC   ER33+5(21),ER39D        REBLOCK AND FIELD SELECT         10512682
WRITE    LA    7,ER33                                                   10512683
         BALR  14,8                                                     10512684
         LH    6,QORS                                                   10512685
         BAL   14,CVD                  PUT COLUMN IN REG (SEQ)          10512686
         UNPK  ER35+26(2),OUTARA(8)                                     10512687
         LA    7,ER35                                                   10512688
         BALR  14,8                                                     10512689
         LH    6,QORS+2                                                 10512690
         BAL   14,CVD                  PUT LENGTH IN REG (SEQ)          10512691
         UNPK  ER36+16(2),OUTARA(8)                                     10512692
         LA    7,ER36                                                   10512693
         BALR  14,8                                                     10512694
         LH    11,FOR096                                                10512695
         CH    11,ZERO                                                  10512696
         BC    8,SVC                                                    10512697
         SVC   1                                                        10512698
         DC    C'SYSEOJ'               END OF PHASE II, LOAD NEXT PHASE 10512699
SVC      SVC   1                                                        10512700
         DC    C'SYSLOD'                                                10512701
FIXED    MVC   ER32+14(9),ER42         MOVE FIXED TO MESSAGE            10512702
         BC    15,LO                                                    10512703
VAR      MVC   ER32+14(9),ER41         MOVE VARIABLE TO MESAGE          10512704
         BC    15,LO                                                    10512705
OPTOPT   MVC   ER23+14(16),ER46                                         10512706
         BC    15,RETUNR                                                10512707
OPTTOP   MVC   ER23+14(11),ER49                                         10512708
         BC    15,RETUNR                                                10512709
MUV      TM    NOIO,X'02'                                               10512710
         BC    1,STTT                                                   10512711
         MVI   ER25,X'F1'              PUT 1 IN I/O                     10512712
ZIPPY    LA    7,ER25                                                   10512713
         BALR  14,8                    GO TO ERROR ROUTINE              10512714
         BC    15,LOADZ+6                                               10512715
STTT     MVI   ER25,X'F2'              PUT 2 IN I/O                     10512716
         BC    15,ZIPPY                                                 10512717
BCD1     MVC   ER22+13(8),ER48          CARD BCD                        10512718
         BC    15,OUTOPT                                                10512719
STORTO   MVI   ER24+8,X'F2'            PUT 2 IN OUTPUT                  10512720
         BC    15,ZERT                                                  10512721
STORTT   MVI   ER24,X'F2'              PUT 2 IN INPUT                   10512722
         BC    15,LOADZ                                                 10512723
CVD      CVD   10,OUTARA               CONVERT TO DECIMAL               10512724
         OI    OUTARA+7,X'0F'          PUT SIGN INTO CONVERTED NUMBER   10512725
         BCR   15,14                                                    10512726
*                                                                       10512727
***      CONSTANTS                                                      10512728
*                                                                       10512729
         CNOP  0,8                                                      10512730
OUTARA   DC    D'0'                                                     10512731
CCB      DC    F'0'                                                     10512732
         DC    X'0014'                                                  10512733
         DC    YL2(COM)                                                 10512734
COM      DC    X'09'                                                    10512735
         DC    AL3(ER00)                                                10512736
         DC    X'20000032'                                              10512737
ANDOP    DC    X'0000FFFF'                                              10512738
BRANCH   BCR   15,7                                                     10512739
MOVE     MVC   0(0,0),0(0)              DUMMY INST                      10512740
UNPK1    UNPK  0(15,0),0(8,0)                                           10512741
MVI      MVI   0(0),X'F0'                                               10512742
MVC      MVC   0(0,0),0(0)                                              10512743
UNPK2    UNPK  0(0,0),0(0,0)                                            10512744
PACK1    PACK  0(8,0),0(15,0)                                           10512745
XCL      XC    0(0,0),0(0)                                              10512746
PACK2    PACK  0(8,0),0(15,0)                                           10512747
ERRO1    LA    7,ER17                                                   10512748
         BAL   14,CVD                                                   10512749
         UNPK  ER17(3),OUTARA(8)                                        10512750
         BALR  14,8                    GO TO ERROR ROUTINE              10512751
         BC    15,L                                                     10512752
ERRO     LA    7,ER15                                                   10512753
         BAL   14,CVD                                                   10512754
         UNPK  ER15(3),OUTARA(8)                                        10512755
         BALR  14,8                    GO TO ERROR ROUTINE              10512756
         BC    15,L                                                     10512757
XTEN     DC    X'A000'                                                  10512758
XSIX     DC    X'6000'                                                  10512759
ZERO     DC    H'0'                                                     10512760
ONE      DC    X'0001'                                                  10512761
TWO      DC    H'2'                                                     10512762
THREE    DC    H'3'                                                     10512763
SIX      DC    H'6'                                                     10512764
SEVEN    DC    H'7'                                                     10512765
EIGHT    DC    H'8'                                                     10512766
TEN      DC    H'10'                                                    10512767
TWELVE   DC    H'12'                                                    10512768
FORTEN   DC    H'14'                                                    10512769
SIXTEN   DC    H'16'                                                    10512770
EIGHTY   DC    H'80'                                                    10512771
ATEY3    DC    H'83'                                                    10512772
ONE60    DC    H'160'                                                   10512773
TWO56    DC    H'256'                                                   10512774
FOR096   DC    H'4096'                                                  10512775
ATEK     DC    H'8192'                                                  10512776
SWIT     DC    X'0000'                                                  10512777
KONST    DC    X'EF00'                                                  10512778
MAXIO    DC    H'0'                                                     10512779
         DC    X'20'                                                    10512780
ER00     DC    C'CARD TO TAPE UTI'                                      10512781
         DC    C'LITY            '                                      10512782
         DC    F'0'                                                     10512783
         DC    X'11'                                                    10512784
ER0      DC    C'INCORRECT PROGRA'                                      10512785
         DC    C'M'                                                     10512786
         DC    X'16'                                                    10512787
ER1      DC    C'INCORRECT INPUT '                                      10512788
         DC    C'DEVICE'                                                10512789
         DC    X'17'                                                    10512790
ER2      DC    C'INCORRECT OUTPUT'                                      10512791
         DC    C' DEVICE'                                               10512792
         DC    X'1E'                                                    10512793
ER3      DC    C'B ILLEGAL FORMAT'                                      10512794
         DC    C' UTIL MOD CARD'                                        10512795
         DC    X'23'                                                    10512796
ER5      DC    C'FIXED LENGTH REC'                                      10512797
         DC    C'ORD FORMAT REQUI'                                      10512798
         DC    C'RED'                                                   10512799
         DC    X'1C'                                                    10512800
ER6      DC    C'INVALID JOB FOR '                                      10512801
         DC    C'THIS PROGRAM'                                          10512802
         DC    X'1B'                                                    10512803
ER7      DC    C'INVALID INPUT RE'                                      10512804
         DC    C'CORD LENGTH'                                           10512805
         DC    X'1A'                                                    10512806
ER8      DC    C'INVALID INPUT BL'                                      10512807
         DC    C'OCK LENGTH'                                            10512808
         DC    X'1C'                                                    10512809
ER9      DC    C'INVALID OUTPUT R'                                      10512810
         DC    C'ECORD LENGTH'                                          10512811
         DC    X'1B'                                                    10512812
ER10     DC    C'INVALID OUTPUT B'                                      10512813
         DC    C'LOCK LENGTH'                                           10512814
         DC    X'14'                                                    10512815
ER11     DC    C'INVALID INPUT OP'                                      10512816
         DC    C'TION'                                                  10512817
         DC    X'15'                                                    10512818
ER12     DC    C'INVALID OUTPUT O'                                      10512819
         DC    C'PTION'                                                 10512820
         DC    X'15'                                                    10512821
ER13     DC    C'INVALID CARD SEQ'                                      10512822
         DC    C'UENCE'                                                 10512823
         DC    X'1B'                                                    10512824
ER14     DC    C'I/O AREA CANNOT '                                      10512825
         DC    C'BE ASSIGNED'                                           10512826
         DC    X'20'                                                    10512827
ER15     DC    C'    INVALID UNPA'                                      10512828
         DC    C'CK OUTPUT LENGTH'                                      10512829
         DC    X'24'                                                    10512830
ER16     DC    C'    RECORD CAPAC'                                      10512831
         DC    C'ITY EXCEEDED BY '                                      10512832
         DC    C'    '                                                  10512833
         DC    X'1E'                                                    10512834
ER17     DC    C'    INVALID PACK'                                      10512835
         DC    C' OUTPUT LENGTH'                                        10512836
         DC    X'18'                                                    10512837
ER18     DC    C'INPUT RECORD LEN'                                      10512838
         DC    C'GTH     '                                              10512839
         DC    X'16'                                                    10512840
ER19     DC    C'INPUT BLOCK SIZE'                                      10512841
         DC    C'      '                                                10512842
         DC    X'1A'                                                    10512843
ER20     DC    C'OUTPUT RECORD LE'                                      10512844
         DC    C'NGTH      '                                            10512845
         DC    X'17'                                                    10512846
ER21     DC    C'OUTPUT BLOCK SIZ'                                      10512847
         DC    C'E      '                                               10512848
         DC    X'20'                                                    10512849
ER22     DC    C'INPUT OPTION    '                                      10512850
         DC    C'                '                                      10512851
         DC    X'20'                                                    10512852
ER23     DC    C'OUTPUT OPTION   '                                      10512853
         DC    C'                '                                      10512854
         DC    X'1F'                                                    10512855
ER24     DC    C'  INPUT,  OUTPUT'                                      10512856
         DC    C' AREAS ASSIGNED'                                       10512857
         DC    X'20'                                                    10512858
ER25     DC    C'   INPUT / OUTPU'                                      10512859
         DC    C'T AREAS ASSIGNED'                                      10512860
         DC    X'1E'                                                    10512861
ER26     DC    C'FIELD SELECT MUS'                                      10512862
         DC    C'T BE SPECIFIED'                                        10512863
         DC    X'21'                                                    10512864
ER31     DC    C'         INPUT L'                                      10512865
         DC    C'ENGTH EQUALS ZER'                                      10512866
         DC    C'O'                                                     10512867
         DC    X'17'                                                    10512868
ER32     DC    C'RECORD FORMAT   '                                      10512869
         DC    C'       '                                               10512870
         DC    X'1D'                                                    10512871
ER33     DC    C'TYPE            '                                      10512872
         DC    C'             '                                         10512873
         DC    X'1C'                                                    10512874
ER35     DC    C'STARTING SEQUENC'                                      10512875
         DC    C'E COLUMN    '                                          10512876
         DC    X'12'                                                    10512877
ER36     DC    C'SEQUENCE LENGTH '                                      10512878
         DC    C'  '                                                    10512879
ER39A    DC    C'COPY'                                                  10512880
ER39B    DC    C'FIELD SELECT'                                          10512881
ER39C    DC    C'REBLOCK'                                               10512882
ER39D    DC    C'REBLOCK, FIELD S'                                      10512883
         DC    C'ELECT'                                                 10512884
ER40     DC    C'UNDEFINED'                                             10512885
ER41     DC    C'VARIABLE '                                             10512886
ER42     DC    C'FIXED    '                                             10512887
ER43     DC    C'FS  '                                                  10512888
ER44     DC    C'UNPK'                                                  10512889
ER45     DC    C'PACK'                                                  10512890
ER46     DC    C'NO REWIND,UNLOAD'                                      10512891
ER47     DC    C'CARD BINARY'                                           10512892
ER48     DC    C'CARD BCD'                                              10512893
ER49     DC    C'TAPE REWIND'                                           10512894
ER50     DC    C'TAPE REWIND,UNLO'                                      10512895
         DC    C'AD'                                                    10512896
         DC    X'21'                                                    10512897
ERWR     DC    C'    CAN NOT PROC'                                      10512898
         DC    C'ESS HEX PARAMETE'                                      10512899
         DC    C'R'                                                     10512900
         ORG   STAR+3826                                                10512901
NOFS     DS    H                                                        10512902
         END   START                                                    10512903
         TITLE 'PHASE 3&4 CARD TO TAPE'                                 10512904
         START 2752                                                     10512905
STRT     BALR  15,0                                                     10512906
         USING *,15                                                     10512907
         BC    15,INI3                                                  10512908
*                                                                       10512909
****  ** PHASE IV,  CARD TO TAPE PROGRAM **                             10512910
SORS     EQU   2500                                                     10512911
QORS     EQU   2504                                                     10512912
IRCLN    EQU   2508                                                     10512913
IBKSZ    EQU   2510                                                     10512914
ORCLN    EQU   2512                                                     10512915
OBKSZ    EQU   2514                                                     10512916
TPGM     EQU   2516                                                     10512917
TJOB     EQU   2517                                                     10512918
FRCD     EQU   2518                                                     10512919
DOPTN    EQU   2519                                                     10512920
POPTN    EQU   2520                                                     10512921
ICU      EQU   2522                                                     10512922
OCU      EQU   2523                                                     10512923
IBKC     EQU   2524                                                     10512924
OBKC     EQU   2528                                                     10512925
LABIH    EQU   2532                                                     10512926
LABOH    EQU   2534                                                     10512927
LABIT    EQU   2536                                                     10512928
LABOT    EQU   2538                                                     10512929
LABOR    EQU   2540                                                     10512930
AAST     EQU   2542                                                     10512931
LABRTN   EQU   2544                                                     10512932
IPA      EQU   2546                                                     10512933
OPA      EQU   2548                                                     10512934
INA      EQU   2550                                                     10512935
INB      EQU   2552                                                     10512936
OUTA     EQU   2554                                                     10512937
OUTB     EQU   2556                                                     10512938
UCLIM    EQU   2558                                                     10512939
SWHD     EQU   2560                                                     10512940
NOIO     EQU   2561                                                     10512941
HEAD     EQU   2562                                                     10512942
DSTBL    EQU   2706                                                     10512943
*                                                                       10512944
***   INPUT OPERATION                                                   10512945
*                                                                       10512946
         LA    15,2754                                                  10512947
         LM    1,10,REG                                                 10512948
OOPEN    LA    7,P3OHR                                                  10512949
         STH   7,LABRTN                                                 10512950
         STM   1,10,REG                                                 10512951
         LH    7,LABOH                                                  10512952
P3OH     BCR   15,7           BRANCH TO OUTPUT HEADER ROUTINE           10512953
         MVI   CCWOA,X'1F'    WRITE TAPE MARK                           10512954
         SVC   0                                                        10512955
         DC    YL2(CCBOA)                                               10512956
         TM    CCBOA+2,X'80'                                            10512957
         BC    8,*-4                                                    10512958
         MVI   CCWOA,X'01'                                              10512959
P3OHR    LM    1,10,REG                                                 10512960
         BC    15,AAA                                                   10512961
         LA    7,PH3OH+2                                                10512962
         STH   7,LABOH                                                  10512963
AAA      LH    7,OBKSZ        CLEAR OUTPUT AREA                         10512964
         LH    11,OUTA                                                  10512965
         LH    14,OUTB                                                  10512966
         AH    11,OBKSZ                                                 10512967
         AH    14,OBKSZ                                                 10512968
         BCTR  11,0                                                     10512969
         BCTR  14,0                                                     10512970
         MVI   0(11),X'40'                                              10512971
         MVI   0(14),X'40'                                              10512972
         BCT   7,*-12                                                   10512973
ISVC     DC    X'4700'                                                  10512974
         DC    YL2(CCBIA)                                               10512975
AA3      BC    0,AG3          IS INPUT AREA EXHAUSTED                   10512976
AB3      BC    0,AB2          IS 1-INPUT AREA                           10512977
         TM    2(1),X'80'     WAIT INPUT                                10512978
         BC    8,*-4                                                    10512979
         TM    3(1),X'04'     IS INPUT END OF FILE                      10512980
         BC    7,IEOV                                                   10512981
AD4      BC    15,CHGIM       CHANG INPUT LIST                          10512982
         MVC   ITAREA(2),INB                                            10512983
         LA    1,CCBIA                                                  10512984
         STH   1,CHGI1                                                  10512985
         LH    6,INB                                                    10512986
         LR    5,6                                                      10512987
         AH    5,IBKSZ                                                  10512988
         BCTR  5,0                                                      10512989
         BC    15,CHGIX                                                 10512990
CHGIM    MVC   ITAREA(2),INA                                            10512991
         LA    1,CCBIB                                                  10512992
         STH   1,CHGI1                                                  10512993
         LH    6,INA                                                    10512994
         LR    5,6                                                      10512995
         AH    5,IBKSZ                                                  10512996
         BCTR  5,0                                                      10512997
CHGIX    XI    AD4+1,X'F0'                                              10512998
         SVC   0              EXECUTE INPUT                             10512999
CHGI1    DC    YL2(CCBIB)                                               10513000
         BC    15,AG3                                                   10513001
AC2      NI    AB2+1,X'0F'                                              10513002
         BC    15,AD1                                                   10513003
AB2      BC    0,AC2                                                    10513004
         STH   1,*+6                                                    10513005
         SVC   0              EXECUTE INPUT                             10513006
         DC    YL2(CCBIA)                                               10513007
AD1      TM    2(1),X'80'     WAIT INPUT                                10513008
         BC    8,*-4                                                    10513009
         TM    3(1),X'04'     IS INPUT END OF FILE                      10513010
         BC    7,IEOV                                                   10513011
AF1      BC    15,CHGM        CHANGE INPUT LIST                         10513012
         MVC   ITAREA(2),INB                                            10513013
         LA    1,CCBIA                                                  10513014
         STH   1,CHGI2                                                  10513015
         BC    15,CHGX                                                  10513016
CHGM     MVC   ITAREA(2),INA                                            10513017
         LA    1,CCBIB                                                  10513018
         STH   1,CHGI2                                                  10513019
CHGX     LH    6,INA                                                    10513020
         XI    AF1+1,X'F0'                                              10513021
*                                                                       10513022
***   MAIN LINE                                                         10513023
*                                                                       10513024
**    CARD SEQUENCE CHECK                                               10513025
*                                                                       10513026
AG3      BC    15,SHR         IS SEQUENCE CHECK SPECIFIED               10513027
         LH    3,ITAREA                                                 10513028
         BCTR  3,0                                                      10513029
SQMVC    MVC   SQCURR(1),0(3) SET CURRENT SEQUENCE                      10513030
         BC    15,SQOFF       IS FIRST TIME                             10513031
         CLC   SQCURR(10),SQLAST   COMPARE CURRENT SEQ WITH LAST SEQ    10513032
         BC    4,SQERR        ILLEGAL SEQUENCE                          10513033
SQCHG    MVC   SQLAST(10),SQCURR   MOVE CURRENT SEQ TO LAST SEQ         10513034
*                                                                       10513035
**    SHIFT ROUTINE                                                     10513036
*                                                                       10513037
SHR      TM    TJOB,X'01'     IS COPY                                   10513038
         BC    1,BA3          YES, BRANCH TO BA3                        10513039
         LA    7,RTN3         BRANCH TO PHASE II                        10513040
         LH    11,UCLIM                                                 10513041
         BCR   15,11                                                    10513042
RTN3     BXLE  6,4,SSICHK     MODIFY INPUT LOGICAL RECORD ADDRESS       10513043
         NI    AA3+1,X'0F'                                              10513044
         NI    BB3+1,X'0F'                                              10513045
         BC    15,SSOCHK                                                10513046
SSICHK   OI    AA3+1,X'F0'                                              10513047
         OI    BB3+1,X'F0'                                              10513048
SSOCHK   BXLE  10,8,*+12      MODIFY OUTPUT LOGICAL RECORD ADDRESS      10513049
         NI    BA3+1,X'0F'                                              10513050
         BC    15,AK3                                                   10513051
         OI    BA3+1,X'F0'                                              10513052
*                                                                       10513053
***   AUXILIARY INPUT OPERATION                                         10513054
*                                                                       10513055
BA3      BC    0,AA3          IS OUTPUT AREA EXHAUSTED                  10513056
BB3      BC    0,BD3          IS INPUT AREA EXHAUSTED                   10513057
BB2      BC    0,BD3          IS 1-INPUT AREA                           10513058
         SVC   0              EXECUTE INPUT                             10513059
CHGI2    DC    YL2(CCBIB)                                               10513060
         OI    AB2+1,X'F0'                                              10513061
*                                                                       10513062
***   OUTPUT OPERATION                                                  10513063
*                                                                       10513064
BD3      BC    0,BD2          IS 1-OUTPUT AREA                          10513065
         BC    15,BH4                                                   10513066
         TM    2(2),X'80'     WAIT OUTPUT                               10513067
         BC    8,*-4                                                    10513068
         L     7,OBKC         COUNT BLOCKS                              10513069
         LA    7,1(7)                                                   10513070
         ST    7,OBKC                                                   10513071
         TM    3(2),X'04'     IS OUTPUT END OF FILE                     10513072
         BC    7,OEOV                                                   10513073
BF4      BC    15,CHGOM       CHANG OUTPUT LIST                         10513074
         MVC   OTAREA(2),OUTA                                           10513075
         LA    2,CCBOB                                                  10513076
         STH   2,CHGO1                                                  10513077
         LH    10,OUTA                                                  10513078
         BC    15,CHGOX                                                 10513079
CHGOM    MVC   OTAREA(2),OUTB                                           10513080
         LA    2,CCBOA                                                  10513081
         STH   2,CHGO1                                                  10513082
         LH    10,OUTB                                                  10513083
CHGOX    XI    BF4+1,X'F0'                                              10513084
         LR    9,10                                                     10513085
         AH    9,OBKSZ                                                  10513086
         BCTR  9,0                                                      10513087
         SVC   0              EXECUTE OUTPUT                            10513088
CHGO1    DC    YL2(CCBOA)                                               10513089
         BC    15,AA3                                                   10513090
BH4      NI    BD3+5,X'0F'                                              10513091
         BC    15,BF4                                                   10513092
BD2      SVC   0              EXECUTE OUTPUT                            10513093
CHGO2    DC    YL2(CCBOA)                                               10513094
         TM    2(2),X'80'     WAIT OUTPUT                               10513095
         BC    8,*-4                                                    10513096
         L     7,OBKC         COUNT BLOCKS                              10513097
         LA    7,1(7)                                                   10513098
         ST    7,OBKC                                                   10513099
         TM    3(2),X'04'     IS OUTPUT END OF FILE                     10513100
         BC    7,OEOV                                                   10513101
BG2      BC    15,CHGMO       CHANGE OUTPUT LIST                        10513102
         MVC   OTAREA(2),OUTA                                           10513103
         LA    2,CCBOA                                                  10513104
         STH   2,CHGO2                                                  10513105
         BC    15,CHGXO                                                 10513106
CHGMO    MVC   OTAREA(2),OUTB                                           10513107
         LA    2,CCBOB                                                  10513108
         STH   2,CHGO2                                                  10513109
CHGXO    XI    BG2+1,X'F0'                                              10513110
         LH    10,OUTA                                                  10513111
         BC    15,AA3                                                   10513112
*                                                                       10513113
**    SEQUENCE ERROR ROUTINE                                            10513114
*                                                                       10513115
SQOFF    NI    SQMVC+7,X'0F'                                            10513116
         BC    15,SQCHG                                                 10513117
SQERR    MVC   ISQMG+34(1),SQCURR                                       10513118
         MVC   ISQMG+54(1),SQLAST                                       10513119
         SVC   0              LOG MESSAGE                               10513120
         DC    YL2(CCBLG2)                                              10513121
         TM    CCBLG2+2,X'80' WAIT TYPING                               10513122
         BC    8,*-4                                                    10513123
         BC    15,SQCHG                                                 10513124
*                                                                       10513125
***   TAPE OUTPUT END OF REEL ROUTINE                                   10513126
*                                                                       10513127
OEOV     MVI   CCWOA,X'1F'    WRITE TAPE MARK                           10513128
         SVC   0                                                        10513129
         DC    YL2(CCBOA)                                               10513130
         TM    CCBOA+2,X'80'                                            10513131
         BC    8,*-4                                                    10513132
         MVI   CCWOA,X'01'                                              10513133
         LA    7,P3OR+2       SET LINKAGE                               10513134
         STH   7,LABRTN                                                 10513135
         STM   1,10,REG                                                 10513136
         LH    7,LABOR                                                  10513137
P3OR     BCR   15,7           BRANCH TO OUTPUT END OF REEL              10513138
         LM    1,10,REG                                                 10513139
         MVI   CCWOA,X'0F'                                              10513140
         SVC   0                                                        10513141
         DC    YL2(CCBOA)                                               10513142
         TM    CCBOA+2,X'80'                                            10513143
         BC    8,*-4                                                    10513144
         MVI   CCWOA,X'01'                                              10513145
         BC    15,KURU                                                  10513146
OPTN     TM    DOPTN,X'09'    IS UNLOAD OPTION                          10513147
         BC    8,OERW         NO, BRANCH TO OERW                        10513148
         MVI   CCWOA,X'0F'    UNLOAD TAPE                               10513149
         SVC   0                                                        10513150
         DC    YL2(CCBOA)                                               10513151
         TM    CCBOA+2,X'80'                                            10513152
         BC    8,*-4                                                    10513153
         MVI   CCWOA,X'01'                                              10513154
OERW     TM    DOPTN,X'04'    IS REWIND OPTION                          10513155
         BC    8,FLBC         NO, BRANCH TO FLBC                        10513156
         MVI   CCWOA,X'07'    REWIND TAPE                               10513157
         SVC   0                                                        10513158
         DC    YL2(CCBOA)                                               10513159
         TM    CCBOA+2,X'80'                                            10513160
         BC    8,*-4                                                    10513161
         MVI   CCWOA,X'01'                                              10513162
KURU     SR    7,7            LOG END OF REEL FOR OUTPUT                10513163
         IC    7,OCU                                                    10513164
         AH    7,22                                                     10513165
         MVO   FMVO(2),0(2,7)                                           10513166
         UNPK  EORMG+18(3),FMVO(2)                                      10513167
         SVC   0                                                        10513168
         DC    YL2(CCBEOR)                                              10513169
         TM    CCBEOR+2,X'80'                                           10513170
         BC    8,*-4                                                    10513171
FLBC     BC    15,*+12        SET CURRENT UNIT                          10513172
         IC    7,OPA                                                    10513173
         BC    15,*+8                                                   10513174
         IC    7,OPA+1                                                  10513175
         STC   7,OCU                                                    10513176
         STC   7,CCBOA+5                                                10513177
         STC   7,CCBOB+5                                                10513178
         XI    FLBC+1,X'F0'                                             10513179
         LA    7,PH3OHR       SET LINKAGE                               10513180
         STH   7,LABRTN                                                 10513181
         STM   1,10,REG                                                 10513182
         LH    7,LABOH                                                  10513183
PH3OH    BCR   15,7           BRANCH TO OUTPUT OPEN                     10513184
         MVI   CCWOA,X'1F'                                              10513185
         SVC   0                                                        10513186
         DC    YL2(CCBOA)                                               10513187
         TM    CCBOA+2,X'80'                                            10513188
         BC    8,*-4                                                    10513189
         MVI   CCWOA,X'01'                                              10513190
PH3OHR   LM    1,10,REG                                                 10513191
         XC    OBKC(4),OBKC                                             10513192
         TM    BD3+1,X'F0'    IS 1-OUTPUT AREA                          10513193
         BC    8,BF4                                                    10513194
         BC    15,BG2                                                   10513195
*                                                                       10513196
***   CARD INPUT END OF FILE ROUTINE                                    10513197
*                                                                       10513198
IEOV     TM    BA3+1,X'F0'    IS OUTPUT AREA EXHAUSTED                  10513199
         BC    8,IEMG         YES, BRANCH TO IEMG                       10513200
         SH    10,OTAREA      NO, COUNT BLOCK SIZE                      10513201
         STH   10,CCWOA+6     STORE COUNT AT COMMAND WORDS              10513202
         STH   10,CCWOB+6                                               10513203
         LA    3,IEWT         GENERATE LINKAGE YO OUTPUT OPERATION      10513204
         LH    7,BCR                                                    10513205
         STH   7,CHGO1+2                                                10513206
         STH   7,CHGO2+2                                                10513207
         BC    15,BD3                                                   10513208
BCR      BCR   15,3                                                     10513209
IEWT     TM    2(2),X'80'     WAIT OUTPUT                               10513210
         BC    8,*-4                                                    10513211
IEMG     MVI   CCWOA,X'1F'    WRITE TAPE MARK                           10513212
         SVC   0                                                        10513213
         DC    YL2(CCBOA)                                               10513214
         TM    CCBOA+2,X'80'                                            10513215
         BC    8,*-4                                                    10513216
         TM    BD3+1,X'F0'    IS 1-OUTPUT AREA                          10513217
         BC    7,*+16         YES, SKIP                                 10513218
         L     7,OBKC         NO, MODIFY COUNT OF BLOCKS                10513219
         LA    7,1(7)                                                   10513220
         ST    7,OBKC                                                   10513221
         LA    7,P3OT+2       SET LINKAGE                               10513222
         STH   7,LABRTN                                                 10513223
         STM   1,10,REG                                                 10513224
         LH    7,LABOT                                                  10513225
P3OT     BCR   15,7           BRANCH TO END OF FILE ROUTINE             10513226
         LM    1,10,REG                                                 10513227
         LH    7,BCR                                                    10513228
         STH   7,FLBC                                                   10513229
         BAL   3,OPTN                                                   10513230
         SVC   0              LOG MESSAGE                               10513231
         DC    YL2(CCBLG1)                                              10513232
         TM    CCBLG1+2,X'80' WAIT TYPING                               10513233
         BC    8,*-4                                                    10513234
         SVC   1              TERMINATE JOB                             10513235
         DC    CL6'SYSEOJ'                                              10513236
*                                                                       10513237
***   CONSTANT                                                          10513238
*                                                                       10513239
AK3      EQU   BA3                                                      10513240
         CNOP  0,8                                                      10513241
REG      DS    CL40                                                     10513242
CCBIA    DC    X'00000000'                                              10513243
         DC    X'000C'                                                  10513244
         DC    YL2(CCWIA)                                               10513245
CCBIB    DC    X'00000000'                                              10513246
         DC    X'000C'                                                  10513247
         DC    YL2(CCWIB)                                               10513248
CCBOA    DC    X'00000000'                                              10513249
         DC    X'0010'                                                  10513250
         DC    YL2(CCWOA)                                               10513251
CCBOB    DC    X'00000000'                                              10513252
         DC    X'0010'                                                  10513253
         DC    YL2(CCWOB)                                               10513254
CCBLG1   DC    X'00000000'                                              10513255
         DC    X'0014'                                                  10513256
         DC    YL2(CCWLG1)                                              10513257
CCBLG2   DC    X'00000000'                                              10513258
         DC    X'0014'                                                  10513259
         DC    YL2(CCWLG2)                                              10513260
CCBEOR   DC    X'000000000014'                                          10513261
         DC    YL2(CCWEOR)                                              10513262
CCWIA    DC    X'0200000000000000'                                      10513263
CCWIB    DC    X'0200000000000000'                                      10513264
CCWOA    DC    X'0100000000000000'                                      10513265
CCWOB    DC    X'0100000000000000'                                      10513266
CCWLG1   DC    X'09'                                                    10513267
         DC    AL3(TMMG)                                                10513268
         DC    X'0000000B'                                              10513269
CCWLG2   DC    X'09'                                                    10513270
         DC    AL3(ISQMG)                                               10513271
         DC    X'00000040'                                              10513272
CCWEOR   DC    X'09'                                                    10513273
         DC    AL3(EORMG)                                               10513274
         DC    X'00000015'                                              10513275
ITAREA   DS    H                                                        10513276
OTAREA   DS    H                                                        10513277
FMVO     DC    X'000F'                                                  10513278
SQCURR   DC    X'00000000000000000000'                                  10513279
SQLAST   DC    X'00000000000000000000'                                  10513280
TMMG     DC    C' END OF JOB'                                           10513281
ISQMG    DC    C' CARD SEQUENCE E'                                      10513282
         DC    C'RROR. CURRENT SE'                                      10513283
         DC    C'Q            LAS'                                      10513284
         DC    C'T SEQ           '                                      10513285
EORMG    DC    C' END OF TAPE REE'                                      10513286
         DC    C'L    '                                                 10513287
LAST     DS    H                                                        10513288
         ORG   LAST+150                                                 10513289
LAB2     MVC   CCB+5(1),LOCU            GET OUTPUT CURRENT UNIT         10513290
       LH    14,22                                                      10513291
       AH    14,CCB+4                                                   10513292
       MVI   CCW7,X'3F'                                                 10513293
       OC    CCW7(1),3(14)                                              10513294
       XI    CCW7,X'14'                                                 10513295
         L     9,SAVE9                  LOAD VOL SEQ NO IN REG 9        10513296
REW1     MVI   CCW,X'07'                                                10513297
         BAL   14,IOPER                 REWIND TAPE                     10513298
         MVI   CCW,X'02'                                                10513299
         BAL   14,IOPER                 READ TAPE                       10513300
         CLC   LABEL(4),VOL1                                            10513301
         BC    7,REW2                   BRANCH UNEQUAL                  10513302
         TM    SW1,X'FF'                1ST REEL                        10513303
         BC    1,READ1                  BRANCH IF ON  NO 1ST REEL       10513304
         LH    1,LAAST                  MATCH VOL SER NO T/C  GET CARD  10513305
         CLC   1(4,1),UOUT                                              10513306
         BC    7,ABORT                                                  10513307
         CLC   25(6,1),LABEL+4                                          10513308
         BC    7,ENTER                                                  10513309
READ1    MVI   CCW,X'02'                                                10513310
         BAL   14,IOPER                 READ VOL                        10513311
         CLC   LABEL(3),VOL1                                            10513312
         BC    8,READ1                                                  10513313
         CLC   LABEL(4),HDR1            MATCH HDR1                      10513314
         BC    7,MES1                                                   10513315
         LH    2,20                                                     10513316
         CLC   LABEL+48(5),4(2)         MATCH  EXP. DATE                10513317
         BC    2,MES2                                                   10513318
BS1      MVI   CCW,X'27'                BACKSPACE TAPE                  10513319
         BAL   14,IOPER                                                 10513320
         MVC   LABEL(4),HDR1                                            10513321
         TM    SW1,X'FF'                                                10513322
         BC    1,ADD                    BRANCH IF ON NO 1ST REEL        10513323
         MVI   SW1,X'FF'                SET ON SW1                      10513324
         PACK  FILPAC(8),31(4,1)                                        10513325
         CVB   9,FILPAC                                                 10513326
MOVECT   MVC   LABEL+4(76),8(1)                                         10513327
A5       MVI   CCW,X'01'                                                10513328
         BAL   14,IOPER                 WRITE TAPE  LABEL               10513329
         TM    USW,X'20'                                                10513330
         BC    1,BN1                                                    10513331
NEW      MVI   CCW,X'1F'                                                10513332
         BAL   14,IOPER                 WRITE TAPE MARK                 10513333
         ST    9,SAVE9                  SAVE VOL SEQ NO                 10513334
         OI    USW,X'20'                       SET ON 3 BIT             10513335
         LH    5,LLABRT                 GET ADDRESS RETURN              10513336
         BCR   15,5                     BRANCH TO PH 4                  10513337
BN1      LA    14,A5                                                    10513338
         STH   14,URET                                                  10513339
         LH    14,ULAB3                                                 10513340
         BCR   15,14                                                    10513341
REW2     MVI   CCW,X'0F'                                                10513342
         BAL   14,IOPER                 REWIND UNLOAD                   10513343
         SVC   2                                                        10513344
       DC    C'3OSLA '                                                  10513345
         BC    15,REW1                                                  10513346
MES1     SVC   2                                                        10513347
       DC    C'3OHDA '                                                  10513348
         CLI   MES1+7,C'R'                                              10513349
         BC    8,REW1                                                   10513350
         BC    15,BS1                                                   10513351
MES2     SVC   2                                                        10513352
       DC    C'3OEDA '                                                  10513353
         CLI   MES2+7,C'R'                                              10513354
         BC    8,REW1                                                   10513355
         BC    15,BS1                                                   10513356
ADD      LA    9,1(9)                                                   10513357
         CVD   9,FILPAC                                                 10513358
         OI    FILPAC+7,X'0F'                                           10513359
         LH    1,LAAST                                                  10513360
         UNPK  31(4,1),FILPAC                                           10513361
         BC    15,MOVECT                                                10513362
ENTER    SVC   2                                                        10513363
       DC    C'3OVSA '                                                  10513364
         CLI   ENTER+7,C'R'                                             10513365
         BC    8,REW1                                                   10513366
         MVC   25(6,1),LABEL+4                                          10513367
         BC    15,READ1                                                 10513368
IOPER    SVC   0                                                        10513369
         DC    YL2(CCB)                                                 10513370
         TM    CCB+2,X'80'                                              10513371
         BC    8,*-4                                                    10513372
         BCR   15,14                                                    10513373
ABORT  SVC   2                                                          10513374
       DC    C'3LCM  '                                                  10513375
       SVC   1                                                          10513376
         DC    C'SYSEOJ'                                                10513377
         CNOP  0,8                                                      10513378
CCB      DC    F'0'                                                     10513379
         DC    X'0000'                                                  10513380
       DC    YL2(CCW7)                                                  10513381
CCW7   CCW   X'3F',LABEL,X'40',01                                       10513382
CCW      DC    X'00'                                                    10513383
         DC    AL3(LABEL)                                               10513384
         DC    X'0000'                                                  10513385
         DC    X'0050'                                                  10513386
LABEL    DS    20F                                                      10513387
SW1      DC    X'00'                                                    10513388
         CNOP  0,8                                                      10513389
FILPAC   DC    D'0'                                                     10513390
SAVE9    DC    F'0'                                                     10513391
VOL1     DC    C'VOL1'                                                  10513392
HDR1     DC    C'HDR1'                                                  10513393
UOUT     DC    C'UOUT'                                                  10513394
LABSW    EQU   2521                                                     10513395
LOCU     EQU   2523                                                     10513396
LOBKC    EQU   2528                                                     10513397
LLABOH   EQU   2534                                                     10513398
LLABOT   EQU   2538                                                     10513399
LLABOR   EQU   2540                                                     10513400
LAAST    EQU   2542                                                     10513401
LLABRT   EQU   2544                                                     10513402
*                                                                       10513403
*                                                                       10513404
*                                                                       10513405
ULAB     EQU   2732                                                     10513406
URET     EQU   2730                                                     10513407
ULAB4    EQU   2728                                                     10513408
ULAB3    EQU   2726                                                     10513409
ULAB2    EQU   2724                                                     10513410
ULAB1    EQU   2722                                                     10513411
USW      EQU   2734                                                     10513412
*                                                                       10513413
*                                                                       10513414
LAB4     MVI   SW2,X'FF'                SET ON SW2                      10513415
         MVC   LABEL(4),EOF1            MOVE EOF1 TO LABEL              10513416
GETCAR   LH    1,LAAST                  GET CARD                        10513417
         MVC   LABEL+4(76),8(1)         MOVE CARD TO LABEL              10513418
         L     8,LOBKC                                                  10513419
         CVD   8,FILPAC                                                 10513420
         OI    FILPAC+7,X'0F'                                           10513421
         UNPK  LABEL+54(6),FILPAC                                       10513422
H2       MVC   CCB+5(1),LOCU                                            10513423
         MVI   CCW,X'01'                                                10513424
         BAL   14,IOPER                 WRITE LABEL                     10513425
         TM    USW,X'10'                                                10513426
         BC    1,BN2                                                    10513427
         OI    USW,X'10'                                                10513428
H3       MVI   CCW,X'1F'                                                10513429
         BAL   14,IOPER                 WRITE TAPE MARK                 10513430
         TM    SW2,X'FF'                TEST SW2  FOR EOV OR EOF        10513431
         BC    1,LTM                                                    10513432
EXIT     LH    5,LLABRT                                                 10513433
         BCR   15,5                                                     10513434
LTM      BAL   14,IOPER                 WRITE  LAST  TAPE  MARK         10513435
         BC    15,EXIT                                                  10513436
*                                                                       10513437
BN2      LA    14,H2                                                    10513438
         STH   14,URET                                                  10513439
         LH    14,ULAB4                                                 10513440
         BCR   15,14                                                    10513441
*                                                                       10513442
LAB5     MVC   LABEL(4),EOV1                                            10513443
         BC    15,GETCAR                                                10513444
*                                                                       10513445
*                                                                       10513446
SW2      DC    X'00'                    TO TEST EOV OR EOF              10513447
EOV1     DC    C'EOV1'                                                  10513448
EOF1     DC    C'EOF1'                                                  10513449
INI3     LA    1,NEW                                                    10513450
         STH   1,ULAB3                                                  10513451
         LA    1,H3                                                     10513452
         STH   1,ULAB4                                                  10513453
         LA    1,LABEL                                                  10513454
         STH   1,ULAB                                                   10513455
         TM    LABSW,X'20'                                              10513456
         BC    8,LOAD                                                   10513457
         LA    1,LAB2                   YES                             10513458
         STH   1,LLABOH                 LOAD ADDRESS IN                 10513459
         LA    1,LAB4                      COMUN AREA                   10513460
         STH   1,LLABOT                                                 10513461
         LA    1,LAB5                                                   10513462
         STH   1,LLABOR                                                 10513463
LOAD     BC    15,STAT                                                  10513464
LABMAN   DS    20F                                                      10513465
*                                                                       10513466
***   INITIALIZATION                                                    10513467
*                                                                       10513468
STAT     TM    DOPTN,X'10'    IS BINAREY READING                        10513469
         BC    8,*+12         NO, SKIP                                  10513470
         OI    CCWIA,X'20'    YES, MODIFY COMMAND CODE                  10513471
         OI    CCWIB,X'20'                                              10513472
         LH    1,IBKSZ        STORE COUNT AT COMMAND WORDS              10513473
         STH   1,CCWIA+6                                                10513474
         STH   1,CCWIB+6                                                10513475
         LH    1,OBKSZ                                                  10513476
         STH   1,CCWOA+6                                                10513477
         STH   1,CCWOB+6                                                10513478
         MVC   CCWIA+2(2),INA STORE STARTINGADDRESS AT COMMAND          10513479
         MVC   CCWIB+2(2),INB WORDS                                     10513480
         MVC   CCWOA+2(2),OUTA                                          10513481
         MVC   CCWOB+2(2),OUTB                                          10513482
         LA    1,CCBIA        SET INPUT CCB FOR AREA A                  10513483
         LA    2,CCBOA        SET OUTPUT CCB FOR AREA A                 10513484
         LH    4,IRCLN        SET REGISTER 4,5,6                        10513485
         LH    5,INA                                                    10513486
         LR    6,5                                                      10513487
         AH    5,IBKSZ                                                  10513488
         BCTR  5,0                                                      10513489
         LH    8,ORCLN        SET REGISTER 8,9,10                       10513490
         LH    9,OUTA                                                   10513491
         LR    10,9                                                     10513492
         AH    9,OBKSZ                                                  10513493
         BCTR  9,0                                                      10513494
         SR    3,3                                                      10513495
         A     3,QORS         IS SEQUENCE CHECK SPECIFIED               10513496
         BC    8,INLAB        NO, BRANCH TO INLAB                       10513497
         MVC   SQMVC+5(1),QORS+1                                        10513498
         LH    3,QORS+2                                                 10513499
         BCTR  3,0                                                      10513500
         STC   3,SQMVC+1                                                10513501
         STC   3,SQERR+1                                                10513502
         STC   3,SQERR+7                                                10513503
         NI    AG3+1,X'0F'                                              10513504
INLAB    CLI   LABOH,C'*'     IS OUTPUT LABEL DEFINED                   10513505
         BC    7,*+32         YES, SKIP                                 10513506
         LA    7,P3OH+2      NO, PROVIDE ADDRESSES                      10513507
         STH   7,LABOH                                                  10513508
         LA    7,P3OT+2                                                 10513509
         STH   7,LABOT                                                  10513510
         LA    7,P3OR+2                                                 10513511
         STH   7,LABOR                                                  10513512
         NI    P3OHR+5,X'0F'                                            10513513
         MVC   OCU(1),OPA     SET CURRENT UNIT                          10513514
*                                                                       10513515
***   SETTING SWITCH ROUTINE                                            10513516
*                                                                       10513517
SSR      TM    TJOB,X'01'     IS COPY                                   10513518
         BC    8,IOSC11       NO, BRANCH TO IOSC11                      10513519
         OI    AB3+1,X'F0'                                              10513520
         NI    BA3+1,X'0F'                                              10513521
         OI    BD3+1,X'F0'                                              10513522
         TM    NOIO,X'01'     IS 1-INPUT-OUTPUT AREA                    10513523
         BC    8,STSR         NO, BRANCH TO STSR                        10513524
         OI    BB3+1,X'F0'                                              10513525
         BC    15,DAME                                                  10513526
STSR     NI    BB3+1,X'0F'    NO, 2-INPUT-OUTPUT AREAS                  10513527
         NI    BB2+1,X'0F'                                              10513528
         BC    15,DAME                                                  10513529
IOSC11   TM    NOIO,X'11'     ARE 1-INPUT 1-OUTPUT AREAS                10513530
         BC    12,IOSC12      NO, BRANCH TO IOSC12                      10513531
         OI    AB3+1,X'F0'                                              10513532
         OI    BD3+1,X'F0'                                              10513533
         NI    BB2+1,X'0F'                                              10513534
         BC    15,DAME                                                  10513535
IOSC12   TM    NOIO,X'12'     ARE 1-INPUT 2-OUTPUT AREAS                10513536
         BC    12,IOSC21      NO, BRANCH TO IOSC21                      10513537
         OI    AB3+1,X'F0'                                              10513538
         NI    BB2+1,X'0F'                                              10513539
         NI    BD3+1,X'0F'                                              10513540
         BC    15,DAME                                                  10513541
IOSC21   MVI   ISVC,X'0A'                                               10513542
         NI    AB3+1,X'0F'                                              10513543
         OI    BB2+1,X'F0'                                              10513544
         TM    NOIO,X'21'     ARE 2-INPUT 1-OUTPUT AREAS                10513545
         BC    12,IOSC22      NO, BRANCH TO IOSC22                      10513546
         OI    BD3+1,X'F0'                                              10513547
         BC    15,DAME                                                  10513548
IOSC22   NI    BD3+1,X'0F'                                              10513549
DAME     STM   1,10,REG                                                 10513550
         SVC   1                                                        10513551
         END   STRT                                                     10513552
