TITLE 'HMBLKIDR -- IDR LISTING PROCESSOR' 00010000 LCLA &T,&SPN 0001 00020000 .@001 ANOP 0001 00030000 HMBLKIDR CSECT , 0001 00040000 BC 15,14(0,@F) 00050000 DC C'ÊHMBLKIDR' 0001 00060000 ST @E,12(0,@D) 0001 00070000 STM @0,@C,20(@D) 0001 00080000 BALR @9,0 0001 00090000 @PSTART DS 0H 0001 00100000 USING @PSTART+00000,@9 0001 00110000 LA @B,4095(0,@9) 0001 00120000 USING @PSTART+04095,@B 0001 00130000 L @0,@SIZ001 0001 00140000 GETMAIN R,LV=(0) 0001 00150000 LR @C,@1 0001 00160000 USING @DATD+00000,@C 0001 00170000 LM @0,@1,20(@D) 0001 00180000 XC @TEMPS(@L),@TEMPS 0001 00190000 ST @D,@SAV001+4 0001 00200000 LA @F,@SAV001 0001 00210000 ST @F,8(0,@D) 0001 00220000 LR @D,@F 0001 00230000 * PARMPTR=REG1; /* START OF PLIST * 00240000 ST @1,PARMPTR 0080 00250000 * TRNOUT=GMLENGTH/3; /* DIVIDE AREA INTO 3 PARTS * 00260000 L @3,PARMPTR 0081 00270000 L @E,16(0,@3) 0081 00280000 SRDA @E,32 0081 00290000 LA @0,3 0081 00300000 DR @E,@0 0081 00310000 ST @F,TRNOUT 0081 00320000 * CSDPT=AREAGET; /* START OF CESD TABLE * 00330000 MVC CSDPT(4),12(@3) 0082 00340000 * SORTOUT=AREAGET+GMLENGTH/3; /* START OF SORTAREA * 00350000 L @E,16(0,@3) 0083 00360000 SRDA @E,32 0083 00370000 LA @0,3 0083 00380000 DR @E,@0 0083 00390000 A @F,12(0,@3) 0083 00400000 ST @F,SORTOUT 0083 00410000 * TRNOUT=SORTOUT+TRNOUT/2; /* START OF TRANS DESCRIP * 00420000 L @E,TRNOUT 0084 00430000 SRDA @E,32 0084 00440000 LA @0,2 0084 00450000 DR @E,@0 0084 00460000 A @F,SORTOUT 0084 00470000 ST @F,TRNOUT 0084 00480000 * OUT=SORTOUT+GMLENGTH/3; /* START OF PRINT AREA * 00490000 L @E,16(0,@3) 0085 00500000 SRDA @E,32 0085 00510000 LA @0,3 0085 00520000 DR @E,@0 0085 00530000 A @F,SORTOUT 0085 00540000 ST @F,OUT 0085 00550000 * CSDNXT=CSDPT; /* FORWARD PTR FOR CESD TABLE * 00560000 MVC CSDNXT(4),CSDPT 0086 00570000 * FLG1='00'X; /* ZAP FLAG * 00580000 MVI FLG1,X'00' 0087 00590000 * ESDNO = 0; /* YM3113P * 00600000 SR @F,@F 0088 00610000 STH @F,ESDNO 0088 00620000 * LL = 0; /* YM3113P * 00630000 STH @F,LL 0089 00640000 * SW1(1:2)='00'B; /* ZERO OUT BITS * 00650000 NI SW1,B'00111111' 0090 00660000 * TYP='0'B; 00670000 NI TYP,B'01111111' 0091 00680000 * PG='0001'; /* FOR PAGE NUMBER * 00690000 MVC PG(4),@C4 0092 00700000 * PGCNT=1; /* PGCNT=BINARY ONE @ZA04919* 00710000 LA @F,1 0093 00720000 STH @F,PGCNT 0093 00730000 * BLANKS=' '; /* FOR BLANKING OUT AREAS * 00740000 MVI BLANKS,C' ' 0094 00750000 * RESTRICT (5,6); /* RESTRICT R5 AND R6 * 00760000 * GEN DATA; 00770000 * READRT: R6=DCBIN; /* ADDR OF INPUT DCB * 00780000 READRT L @3,PARMPTR 0097 00790000 L @6,0(0,@3) 0097 00800000 * R5=BUFF; /* ADDR OF READ BUFFER * 00810000 L @5,24(0,@3) 0098 00820000 * GENERATE; 00830000 MVC READLIST(RDLGTH),RDLIST MOVE IN LIST FORM OF READ 00840000 READ READLIST,SF,(6),(5),'S',MF=E 00850000 CHECK READLIST 00860000 DS 0H 00870000 * IF NOTEDIT='1'B /* NOT-EDITABLE MODULE? * 00880000 * THEN /* YES * 00890000 TM 20(@3),B'00100000' 0100 00900000 BC 12,@9FF 0100 00910000 * DO; /* BEGIN DO LOOP * 00920000 * GENERATE; 00930000 NOTE (R6) GET TTR FROM READ 00940000 ST 1,NOTETTR SAVE TTR 00950000 DS 0H 00960000 * NOTEDIT='0'B; /* TURN OFF NOT-EDITABLE BIT * 00970000 NI 20(@3),B'11011111' 0103 00980000 * IF NOTETTR(1:3)=TXTTR /* IS 1ST RECORD TEXT? * 00990000 * THEN /* YES * 01000000 CLC NOTETTR(3),52(@3) 0104 01010000 BC 07,@9FE 0104 01020000 * IF NORLD='1'B /* NO RLD RECORDS? * 01030000 * THEN /* NO RLDS * 01040000 TM 20(@3),B'00010000' 0105 01050000 * GOTO ERR2; /* ERROR MSG NO IDR DATA * 01060000 BC 01,ERR2 0106 01070000 * ELSE /* RLD RECORDS * 01080000 * GOTO READRT; /* READ ANOTHER RECORD * 01090000 BC 15,READRT 0107 01100000 * END; 01110000 @9FE EQU * 0108 01120000 * INREC=BUFF; /* INPUT RECORD ADDRESS * 01130000 @9FF L @3,PARMPTR 0109 01140000 MVC INREC(4),24(@3) 0109 01150000 * RELEASE (5,6); /* RELEASE RESTRICTION * 01160000 * IF TYPE='40'X /* SYM RECORD? * 01170000 * THEN /* YES * 01180000 L @8,INREC 0111 01190000 CLI 0(@8),X'40' 0111 01200000 * GO TO READRT; /* READ NEXT RECORD * 01210000 BC 08,READRT 0112 01220000 * ELSE; /* NULL ELSE * 01230000 * IF TYPE='20'X /* CESD RECORD * 01240000 * THEN /* YES * 01250000 CLI 0(@8),X'20' 0114 01260000 BC 07,@9FD 0114 01270000 * DO; /* BEGINNING OF DO LOOP * 01280000 * ESDNO=ESDID; /* STARTING ID NUMBER * 01290000 MVC ESDNO(2),4(@8) 0116 01300000 * ESDCOUNT=COUNT; /* NUMBER OF ESD DATA BYTES * 01310000 MVC ESDCOUNT(2),6(@8) 0117 01320000 * NEXT=INREC+8; /* START OF ESD DATA * 01330000 LA @F,8 0118 01340000 A @F,INREC 0118 01350000 ST @F,NEXT 0118 01360000 * TBIT='00'X; /* ZERO OUT SPECIAL BYTE * 01370000 MVI TBIT,X'00' 0119 01380000 * GO TO CESDRT; /* BRANCH TO CESD RTN. * 01390000 BC 15,CESDRT 0120 01400000 * END; /* END OF DO LOOP * 01410000 * ELSE; /* NULL ELSE * 01420000 @9FD EQU * 0122 01430000 * IF TYPE='80'X /* IDR RECORD * 01440000 * THEN /* YES * 01450000 @9FC L @3,INREC 0123 01460000 CLI 0(@3),X'80' 0123 01470000 BC 07,@9FB 0123 01480000 * DO; /* DO LOOP * 01490000 * SW1(1)='1'B; /* SET SWITCH - IDR * 01500000 OI SW1,B'10000000' 0125 01510000 * GO TO IDRTN; /* PROCESS IDR RECORD * 01520000 BC 15,IDRTN 0126 01530000 * END; /* END OF DO LOOP * 01540000 * ELSE 01550000 * DO; /* DO LOOP * 01560000 * IF SW1(1)='0'B /* HAVE IDR'S BEEN PROCESSED * 01570000 * THEN /* NO * 01580000 @9FB TM SW1,B'10000000' 0129 01590000 * GO TO ERR2; /* NO IDR RECORDS * 01600000 BC 08,ERR2 0130 01610000 * ELSE /* YES * 01620000 * GO TO ERR3; /* MISSING IDR RECORDS * 01630000 BC 15,ERR3 0131 01640000 * END; /* END OF DO LOOP * 01650000 * CESDRT: IF ESDTYP(5:8)='0000'B 01660000 * THEN 01670000 @9FA EQU * 0133 01680000 CESDRT L @3,NEXT 0133 01690000 TM 8(@3),B'00001111' 0133 01700000 * GO TO CSDRT1; /* BEGIN PROCESSING CSED REC * 01710000 BC 08,CSDRT1 0134 01720000 * ELSE; /* NULL ELSE * 01730000 * IF ESDTYP(5:8)='0100'B /* PRIVATE CODE * 01740000 * THEN /* YES * 01750000 TM 8(@3),B'00000100' 0136 01760000 BC 12,@9F9 0135 01770000 TM 8(@3),B'00001011' 0136 01780000 BC 05,@9F8 0136 01790000 * DO; 01800000 * NAME='$PRIVATE'; /* PUT NAME IN * 01810000 L @8,CSDNXT 0138 01820000 MVC 0(8,@8),@C12 0138 01830000 * GO TO CSDPVT; /* BEGIN PROCESSING CSED REC * 01840000 BC 15,CSDPVT 0139 01850000 * END; 01860000 * ELSE 01870000 * DO; 01880000 @9F8 EQU * 0141 01890000 @9F9 EQU * 0141 01900000 * CSD: ESDCOUNT=ESDCOUNT-16; /* RECORD LENGTH COUNT * 01910000 CSD LH @F,ESDCOUNT 0142 01920000 SH @F,@D1 0142 01930000 STH @F,ESDCOUNT 0142 01940000 * IF ESDCOUNT = 0 /* ANY MORE DATA? * 01950000 * THEN /* NO * 01960000 SR @F,@F 0143 01970000 CH @F,ESDCOUNT 0143 01980000 * GO TO READRT; /* READ NEXT RECORD * 01990000 BC 08,READRT 0144 02000000 * ELSE /* YES - MORE DATA * 02010000 * DO; /* DO LOOP * 02020000 * NEXT=NEXT+16; /* UP RECORD PTR * 02030000 LA @F,16 0146 02040000 A @F,NEXT 0146 02050000 ST @F,NEXT 0146 02060000 * ESDNO=ESDNO+1; /* UP ESDID NUMBER * 02070000 LA @F,1 0147 02080000 AH @F,ESDNO 0147 02090000 STH @F,ESDNO 0147 02100000 * GO TO CESDRT; /* CONTINUE PROCESSING * 02110000 BC 15,CESDRT 0148 02120000 * END; /* END OF DO LOOP * 02130000 * END; /* END OF DO LOOP * 02140000 * CSDRT1: NAME=EXTRNAM; /* PUT NAME IN TABLE * 02150000 @9F7 EQU * 0151 02160000 CSDRT1 L @3,NEXT 0151 02170000 L @8,CSDNXT 0151 02180000 MVC 0(8,@8),0(@3) 0151 02190000 * CSDPVT: IDEN=ESDNO; /* PUT ESD NUMBER IN TABLE * 02200000 CSDPVT L @3,CSDNXT 0152 02210000 MVC 10(2,@3),ESDNO 0152 02220000 * IF CSDNXT+12>SORTOUT /* CHK FOR TBL OVERFL XM04400 * 02230000 * THEN /* OVERFLOW XM04400 * 02240000 LA @F,12 0153 02250000 A @F,CSDNXT 0153 02260000 C @F,SORTOUT 0153 02270000 BC 12,@9F6 0153 02280000 * DO; /* XM04400 * 02290000 * ERRORS(4)='1'B; /* MSG IMB104I XM04400 * 02300000 L @8,PARMPTR 0155 02310000 OI 32(@8),B'00010000' 0155 02320000 * RETURN; /* EXIT XM04400 * 02330000 BC 15,@EL01 0156 02340000 * END; /* XM04400 * 02350000 * ELSE; /* NO OVERFLOW XM04400 * 02360000 @9F6 EQU * 0158 02370000 * CSDEND=CSDNXT; /* ADDR OF LAST CESD ENTRY * 02380000 @9F5 MVC CSDEND(4),CSDNXT 0159 02390000 * CSDRT2: ESDCOUNT=ESDCOUNT-16; /* AMOUNT OF ESD DATA LEFT * 02400000 CSDRT2 LH @F,ESDCOUNT 0160 02410000 SH @F,@D1 0160 02420000 STH @F,ESDCOUNT 0160 02430000 * IF ESDCOUNT=0 /* END OF ESD DATA? * 02440000 * THEN /* YES * 02450000 SR @F,@F 0161 02460000 CH @F,ESDCOUNT 0161 02470000 BC 07,@9F4 0161 02480000 * DO; /* DO LOOP * 02490000 * CSDNXT=CSDNXT+12; /* UP CESD PTR * 02500000 LA @F,12 0163 02510000 A @F,CSDNXT 0163 02520000 ST @F,CSDNXT 0163 02530000 * GO TO READRT; /* READ NEXT RECORD * 02540000 BC 15,READRT 0164 02550000 * END; /* END OF DO LOOP * 02560000 * ELSE /* NO * 02570000 * DO; /* DO LOOP START * 02580000 * CSDNXT=CSDNXT+12; /* FOR NEXT CESD ENTRY * 02590000 @9F4 LA @F,12 0167 02600000 A @F,CSDNXT 0167 02610000 ST @F,CSDNXT 0167 02620000 * NEXT=NEXT+16; /* FOR NEXT ESD DATA ITEM * 02630000 LA @F,16 0168 02640000 A @F,NEXT 0168 02650000 ST @F,NEXT 0168 02660000 * ESDNO=ESDNO+1; /* ESDID NUMBER * 02670000 LA @F,1 0169 02680000 AH @F,ESDNO 0169 02690000 STH @F,ESDNO 0169 02700000 * GO TO CESDRT; /* FOR NEXT ENTRY * 02710000 BC 15,CESDRT 0170 02720000 * END; /* END OF DO LOOP * 02730000 * IDRTN: IF SUBTYP(1)='1'B /* LAST IDR RECORD? * 02740000 * THEN /* YES * 02750000 @9F3 EQU * 0172 02760000 IDRTN L @3,INREC 0172 02770000 TM 2(@3),B'10000000' 0172 02780000 BC 12,@9F2 0172 02790000 * TYP='1'B; /* SET BIT * 02800000 OI TYP,B'10000000' 0173 02810000 * ELSE; /* NO * 02820000 @9F2 EQU * 0174 02830000 * BYTES=BYTCNT-2; /* NUMBER OF BYTES IN RECORD * 02840000 @9F1 LH @F,@D2 0175 02850000 SR @0,@0 0175 02860000 IC @0,1(0,@3) 0175 02870000 AR @F,@0 0175 02880000 STC @F,BYTES 0175 02890000 * IF SUBTYP(5:8)='0001'B /* ZAP RECORD * 02900000 * THEN /* YES * 02910000 TM 2(@3),B'00000001' 0176 02920000 BC 12,@9F0 0175 02930000 TM 2(@3),B'00001110' 0176 02940000 * GO TO ZAPRT; /* BEGIN PROCESSING ZAP REC * 02950000 BC 10,ZAPRT 0177 02960000 * ELSE /* NO * 02970000 * GO TO LK; /* CHECK FOR NEXT TYPE * 02980000 BC 15,LK 0178 02990000 * IDR2: IF IDRFLAG='1'B | MDLB='1'B /* PARTIAL IDR SERVICE * 03000000 * THEN /* YES * 03010000 IDR2 L @3,PARMPTR 0179 03020000 TM 20(@3),B'10000000' 0179 03030000 BC 01,@9EE 0179 03040000 TM 20(@3),B'00001000' 0179 03050000 BC 12,@9ED 0179 03060000 * IF TYP='1'B /* LAST IDR RECORD * 03070000 * THEN /* YES * 03080000 @9EE TM TYP,B'10000000' 0180 03090000 * RETURN; /* RETURN * 03100000 BC 03,@EL01 0181 03110000 * ELSE /* MORE IDR RECORDS * 03120000 * GO TO READRT; /* READ NEXT RECORD * 03130000 BC 15,READRT 0182 03140000 * ELSE /* FULL IDR SERVICE * 03150000 * DO; /* DO LOOP * 03160000 * COUNTER=BYTES; /* NO. OF RECORD BYTES * 03170000 @9ED MVC COUNTER(1),BYTES 0184 03180000 * GO TO TRANSRT; /* PROCESS RECORD * 03190000 BC 15,TRANSRT 0185 03200000 * END; /* END OF DO LOOP * 03210000 * LK: IF SUBTYP(5:8)='0010'B /* LINKEDIT RECORD * 03220000 * THEN /* YES * 03230000 @9EA EQU * 0187 03240000 LK L @3,INREC 0187 03250000 TM 2(@3),B'00000010' 0187 03260000 BC 12,@9E9 0186 03270000 TM 2(@3),B'00001101' 0187 03280000 BC 05,@9E8 0187 03290000 * DO; /* DO LOOP * 03300000 * IF IDRFLAG='1'B | MDLB='1'B /* PARTIAL IDR SERVICE * 03310000 * THEN /* YES * 03320000 L @8,PARMPTR 0189 03330000 TM 20(@8),B'10000000' 0189 03340000 BC 01,@9E7 0189 03350000 TM 20(@8),B'00001000' 0189 03360000 BC 12,@9E6 0189 03370000 * IF TYP='1'B /* LAST IDR RECORD * 03380000 * THEN /* YES * 03390000 @9E7 TM TYP,B'10000000' 0190 03400000 * RETURN; 03410000 BC 03,@EL01 0191 03420000 * ELSE /* NO * 03430000 * GO TO READRT; /* READ NEXT RECORD * 03440000 BC 15,READRT 0192 03450000 * ELSE /* FULL IDR SERVICE * 03460000 * GO TO LKERT; /* BEGIN PROCESSING LINKEDIT * 03470000 * END; /* END OF DO LOOP * 03480000 * ELSE; /* NO * 03490000 @9E8 EQU * 0195 03500000 @9E9 EQU * 0195 03510000 * IF SUBTYP(5:8)='0100'B /* TRANSLATOR RECORD * 03520000 * THEN /* YES * 03530000 @9E2 EQU * 0196 03540000 L @3,INREC 0196 03550000 TM 2(@3),B'00000100' 0196 03560000 BC 12,@9E1 0195 03570000 TM 2(@3),B'00001011' 0196 03580000 BC 05,@9E0 0196 03590000 * DO; /* DO LOOP * 03600000 * NEXT=INREC+3; /* RECORD PTR * 03610000 LA @F,3 0198 03620000 A @F,INREC 0198 03630000 ST @F,NEXT 0198 03640000 * IF TBIT(1)='1'B /* PREVIOUS TRANSLATOR RECORD * 03650000 * THEN /* YES * 03660000 TM TBIT,B'10000000' 0199 03670000 BC 12,@9DF 0199 03680000 * DO; /* DO LOOP * 03690000 * TBIT(1)='0'B; /* ZERO OUT BIT * 03700000 NI TBIT,B'01111111' 0201 03710000 * COUNTER=BYTES; /* NO. OF RECORD BYTES * 03720000 MVC COUNTER(1),BYTES 0202 03730000 * GO TO TR1; /* ANALYZE RECORD * 03740000 BC 15,TR1 0203 03750000 * END; /* END OF DO LOOP * 03760000 * ELSE; /* NO * 03770000 @9DF EQU * 0205 03780000 * IF TBIT(7)='1'B /* TRANS DESCRIPTION * 03790000 * THEN /* YES * 03800000 @9DE TM TBIT,B'00000010' 0206 03810000 BC 12,@9DD 0206 03820000 * DO; /* DO LOOP * 03830000 * TBIT(7)='0'B; /* ZERO OUT BIT * 03840000 NI TBIT,B'11111101' 0208 03850000 * COUNTER=BYTES; /* NO. OF RECORD BYTES * 03860000 MVC COUNTER(1),BYTES 0209 03870000 * GO TO TR1A; /* CONTINUE PROCESSING * 03880000 BC 15,TR1A 0210 03890000 * END; /* END OF DO LOOP * 03900000 * ELSE; /* NULL ELSE * 03910000 @9DD EQU * 0212 03920000 * IF TBIT(3)='1'B /* TRANS DESCRIP CONTIN MIDPT * 03930000 * THEN /* YES * 03940000 @9DC TM TBIT,B'00100000' 0213 03950000 BC 12,@9DB 0213 03960000 * DO; /* DO LOOP * 03970000 * COUNTER=15; /* SET COUNTER * 03980000 MVI COUNTER,15 0215 03990000 * POINT=ADDR(B1); /* LINK ADDRESS * 04000000 LA @F,B1 0216 04010000 ST @F,POINT 0216 04020000 * GO TO SP1; /* BYTE BY BYTE MOVE * 04030000 BC 15,SP1 0217 04040000 * B1: COUNTER=BYTES-15; /* SUBTRACT BYTES MOVED * 04050000 B1 SR @F,@F 0218 04060000 IC @F,BYTES 0218 04070000 SH @F,@D3 0218 04080000 STC @F,COUNTER 0218 04090000 * TBIT(3)='0'B; /* ZERO OUT BIT * 04100000 NI TBIT,B'11011111' 0219 04110000 * GO TO TR1; /* ANALYZE RECORD * 04120000 BC 15,TR1 0220 04130000 * END; /* END OF DO LOOP * 04140000 * ELSE; /* NO * 04150000 @9DB EQU * 0222 04160000 * IF TBIT(6)='1'B /* TRANS DESCRIP CONTIN * 04170000 * THEN /* YES * 04180000 @9DA TM TBIT,B'00000100' 0223 04190000 BC 12,@9D9 0223 04200000 * DO; /* DO LOOP * 04210000 * TBIT(6)='0'B; /* ZERO OUT BIT * 04220000 NI TBIT,B'11111011' 0225 04230000 * POINT=ADDR(B2); /* LINK ADDRESS * 04240000 LA @F,B2 0226 04250000 ST @F,POINT 0226 04260000 * GO TO SP1; /* BYTE BY BYTE MOVE * 04270000 BC 15,SP1 0227 04280000 * B2: COUNTER=BYTES-COUNTER; /* BYTES LEFT * 04290000 B2 SR @F,@F 0228 04300000 IC @F,BYTES 0228 04310000 SR @0,@0 0228 04320000 IC @0,COUNTER 0228 04330000 SR @F,@0 0228 04340000 STC @F,COUNTER 0228 04350000 * IF TBIT(5)='1'B /*SECOND XLATOR @ZA03924 * 04360000 * THEN /* SPLIT THEN @ZA03924 * 04370000 TM TBIT,B'00001000' 0229 04380000 BC 12,@9D8 0229 04390000 * DO; /* TURN OFF BIT @ZA03924 * 04400000 * TBIT(5)='0'B; /* AND CONTINUE @ZA03924 * 04410000 NI TBIT,B'11110111' 0231 04420000 * GO TO TR1; /* NORMAL PROC @ZA03924 * 04430000 BC 15,TR1 0232 04440000 * END; /* OF RECORD @ZA03924 * 04450000 * ELSE; /* @ZA03924 * 04460000 @9D8 EQU * 0234 04470000 * IF TBIT(8)='1'B /* BIT ON * 04480000 * THEN /* YES * 04490000 @9D7 TM TBIT,B'00000001' 0235 04500000 * GO TO TR1; /* ANALYZE RECORD * 04510000 BC 01,TR1 0236 04520000 * ELSE /* NO * 04530000 * DO; 04540000 * TDTAB=BLANKS; /* SET TRANS DESC TO BLANKS * 04550000 L @3,TRN 0238 04560000 MVC 0(1,@3),BLANKS 0238 04570000 MVI 1(@3),C' ' 0238 04580000 MVC 2(13,@3),1(@3) 0238 04590000 * TRN=TRN+15; /* INCR PTR * 04600000 LA @F,15 0239 04610000 A @F,TRN 0239 04620000 ST @F,TRN 0239 04630000 * END; 04640000 * GO TO TR1; /* ANALYZE REST OF RECORD * 04650000 BC 15,TR1 0241 04660000 * END; /* END OF DO LOOP * 04670000 * ELSE; /* NO * 04680000 @9D9 EQU * 0243 04690000 * IF TBIT(4)='1'B /* ID CONTIN * 04700000 * THEN /* YES * 04710000 @9D6 TM TBIT,B'00010000' 0244 04720000 BC 12,@9D5 0244 04730000 * DO; /* DO LOOP * 04740000 * SAV2=SPBIT; /* ONE BYTE MOVE * 04750000 L @3,NEXT 0246 04760000 MVC IDSAVE+1(1),0(@3) 0246 04770000 * NEXT=NEXT+1; /* UP RECORD PTR * 04780000 LA @F,1 0247 04790000 A @F,NEXT 0247 04800000 ST @F,NEXT 0247 04810000 * COUNTER=BYTES-1; /* NO. OF RECORD BYTES LEFT * 04820000 SR @F,@F 0248 04830000 IC @F,BYTES 0248 04840000 BCTR @F,0 0248 04850000 STC @F,COUNTER 0248 04860000 * GO TO TR1B; /* CONTINUE PROCESSING * 04870000 BC 15,TR1B 0249 04880000 * END; /* END OF DO LOOP * 04890000 * ELSE; /* NO * 04900000 * GO TO IDR2; /* IDR CHECK * 04910000 * END; /* END OF DO LOOP * 04920000 * ELSE; /* NO * 04930000 @9E0 EQU * 0254 04940000 @9E1 EQU * 0254 04950000 * IF SUBTYP(5:8)='1000'B /* IDENTIFY RECORD * 04960000 * THEN /* YES * 04970000 @9D3 EQU * 0255 04980000 L @3,INREC 0255 04990000 TM 2(@3),B'00001000' 0255 05000000 BC 12,@9D2 0254 05010000 TM 2(@3),B'00000111' 0255 05020000 BC 05,@9D1 0255 05030000 * DO; /* * 05040000 * CSDNXT=CSDPT; /* START OF CESD TABLE * 05050000 MVC CSDNXT(4),CSDPT 0257 05060000 * NEXT=INREC+3; /* UP RECORD PTR * 05070000 LA @F,3 0258 05080000 A @F,INREC 0258 05090000 ST @F,NEXT 0258 05100000 * IF TBIT(1)='1'B /* PREVIOUS TRANSLATOR RECORD * 05110000 * THEN /* YES * 05120000 TM TBIT,B'10000000' 0259 05130000 BC 12,@9D0 0259 05140000 * DO; /* DO LOOP * 05150000 * TBIT(1)='0'B; /* ZERO OUT BIT * 05160000 NI TBIT,B'01111111' 0261 05170000 * CALL TRSORT; /* PRINT OUT PREVIOUS RECORD * 05180000 BAL @E,TRSORT 0262 05190000 * COUNTER=BYTES; /* NO. OF RECORD BYTES * 05200000 MVC COUNTER(1),BYTES 0263 05210000 * GO TO IDENRT; /* PROCESS RECORD * 05220000 BC 15,IDENRT 0264 05230000 * END; /* END OF DO LOOP * 05240000 * ELSE; /* NULL ELSE * 05250000 @9D0 EQU * 0266 05260000 * IF TBIT(2)='1'B /* LAST RECORD IDENTIFY * 05270000 * THEN /* YES * 05280000 @9CF TM TBIT,B'01000000' 0267 05290000 BC 12,@9CE 0267 05300000 * DO; /* DO LOOP * 05310000 * TBIT(2)='0'B; /* ZERO OUT BIT * 05320000 NI TBIT,B'10111111' 0269 05330000 * COUNTER=BYTES; /* NO. OF RECORD BYTES * 05340000 MVC COUNTER(1),BYTES 0270 05350000 * GO TO ID3; /* BEGIN PROCESSING * 05360000 BC 15,ID3 0271 05370000 * END; /* END OF LOOP * 05380000 * ELSE; /* NULL ELSE * 05390000 @9CE EQU * 0273 05400000 * IF TBIT(8)='1'B /* BIT ON * 05410000 * THEN /* YES * 05420000 @9CD TM TBIT,B'00000001' 0274 05430000 BC 12,@9CC 0274 05440000 * DO; /* DO LOOP * 05450000 * SAV2=INFO; /* REST OF ID * 05460000 L @3,NEXT 0276 05470000 MVC IDSAVE+1(1),0(@3) 0276 05480000 * NEXT=NEXT+1; /* UP RECORD PTR * 05490000 LA @F,1 0277 05500000 A @F,NEXT 0277 05510000 ST @F,NEXT 0277 05520000 * TBIT(8)='0'B; /* ZERO OUT BIT * 05530000 NI TBIT,B'11111110' 0278 05540000 * SUB1: IF IDEN=IDSAVE /* MATCHING ID'S * 05550000 * THEN /* * 05560000 SUB1 L @3,CSDNXT 0279 05570000 CLC 10(2,@3),IDSAVE 0279 05580000 BC 07,@9CB 0279 05590000 * DO; /* DO LOOP * 05600000 * SRTEND=SRT; /* END OF TABLE ADDRESS * 05610000 MVC SRTEND(4),SRT 0281 05620000 * USNAME=NAME; /* PUT CSECT NAME IN TABLE * 05630000 L @8,SRT 0282 05640000 MVC 0(8,@8),0(@3) 0282 05650000 * SRT=SRT+8; /* UP TABLE PTR * 05660000 LA @F,8 0283 05670000 A @F,SRT 0283 05680000 ST @F,SRT 0283 05690000 * BYTES=BYTES-1; /* NO. OF REC BYTES LEFT * 05700000 SR @F,@F 0284 05710000 IC @F,BYTES 0284 05720000 BCTR @F,0 0284 05730000 STC @F,BYTES 0284 05740000 * GO TO SUB2; /* DO LOOP FOR DATE * 05750000 BC 15,SUB2 0285 05760000 * END; /* END OF LOOP * 05770000 * ELSE /* NO * 05780000 * IF CSDNXT > CSDEND /* END OF CESD TABLE * 05790000 * THEN /* YES * 05800000 @9CB L @F,CSDEND 0287 05810000 C @F,CSDNXT 0287 05820000 * GO TO ERR1; /* ERROR * 05830000 BC 04,ERR1 0288 05840000 * ELSE /* NO * 05850000 * DO; /* DO LOOP * 05860000 * CSDNXT=CSDNXT+12; /* NEXT CESD ENTRY * 05870000 LA @F,12 0290 05880000 A @F,CSDNXT 0290 05890000 ST @F,CSDNXT 0290 05900000 * GO TO SUB1; /* TRY AGAIN * 05910000 BC 15,SUB1 0291 05920000 * END; /* END OF DO LOOP * 05930000 * END; /* END OF DO LOOP * 05940000 * ELSE; /* NULL ELSE * 05950000 @9CC EQU * 0294 05960000 * IF TBIT(7)='1'B /* BIT ON * 05970000 * THEN /* YES * 05980000 @9C9 TM TBIT,B'00000010' 0295 05990000 BC 12,@9C8 0295 06000000 * DO; /* DO LOOP * 06010000 * TBIT(7)='0'B; /* ZERO OUT BIT * 06020000 NI TBIT,B'11111101' 0297 06030000 * GO TO SUB2; /* SAVE DATE AND NO. OF BYTES * 06040000 BC 15,SUB2 0298 06050000 * END; /* END OF LOOP * 06060000 * ELSE; /* NULL ELSE * 06070000 @9C8 EQU * 0300 06080000 * IF TBIT(6)='1'B /* BIT ON * 06090000 * THEN /* YES * 06100000 @9C7 TM TBIT,B'00000100' 0301 06110000 BC 12,@9C6 0301 06120000 * DO; /* DO LOOP * 06130000 * USINFO=INFO; /* MOVE REST OF DATE * 06140000 L @3,NEXT 0303 06150000 L @8,SRT 0303 06160000 MVC 0(1,@8),0(@3) 0303 06170000 * NEXT=NEXT+1; /* UP RECORD PTR * 06180000 LA @F,1 0304 06190000 A @F,NEXT 0304 06200000 ST @F,NEXT 0304 06210000 * SRT=SRT+1; /* UP TABLE PTR * 06220000 LA @F,1 0305 06230000 A @F,SRT 0305 06240000 ST @F,SRT 0305 06250000 * USINFO=INFO; /* MOVE REST OF DATE * 06260000 L @3,NEXT 0306 06270000 LR @8,@F 0306 06280000 MVC 0(1,@8),0(@3) 0306 06290000 * NEXT=NEXT+1; /* UP RECORD PTR * 06300000 LA @F,1 0307 06310000 A @F,NEXT 0307 06320000 ST @F,NEXT 0307 06330000 * SRT=SRT+1; /* UP TABLE PTR * 06340000 LA @F,1 0308 06350000 A @F,SRT 0308 06360000 ST @F,SRT 0308 06370000 * NUMBS=INFO; /* SAVE DATA LENGTH * 06380000 L @3,NEXT 0309 06390000 MVC NUMBS(1),0(@3) 0309 06400000 * NEXT=NEXT+1; /* UP RECORD PTR * 06410000 LA @F,1 0310 06420000 A @F,NEXT 0310 06430000 ST @F,NEXT 0310 06440000 * COUNTER=BYTES-3; /* NUMBER OF RECORD BYTES LEFT* 06450000 SR @F,@F 0311 06460000 IC @F,BYTES 0311 06470000 SH @F,@D4 0311 06480000 STC @F,COUNTER 0311 06490000 * TBIT(6)='0'B; /* ZERO OUT BIT * 06500000 NI TBIT,B'11111011' 0312 06510000 * GO TO ID4; /* CONTINUE PROCESSING * 06520000 BC 15,ID4 0313 06530000 * END; /* END OF LOOP * 06540000 * ELSE; /* NULL ELSE * 06550000 @9C6 EQU * 0315 06560000 * IF TBIT(5)='1'B /* BIT ON * 06570000 * THEN /* YES * 06580000 @9C5 TM TBIT,B'00001000' 0316 06590000 BC 12,@9C4 0316 06600000 * DO; /* DO LOOP * 06610000 * USINFO=INFO; /* MOVE REST OF DATE * 06620000 L @3,NEXT 0318 06630000 L @8,SRT 0318 06640000 MVC 0(1,@8),0(@3) 0318 06650000 * NEXT=NEXT+1; /* UP RECORD PTR * 06660000 LA @F,1 0319 06670000 A @F,NEXT 0319 06680000 ST @F,NEXT 0319 06690000 * SRT=SRT+1; /* UP TABLE PTR * 06700000 LA @F,1 0320 06710000 A @F,SRT 0320 06720000 ST @F,SRT 0320 06730000 * NUMBS=INFO; /* SAVE DATA LENGTH * 06740000 L @3,NEXT 0321 06750000 MVC NUMBS(1),0(@3) 0321 06760000 * NEXT=NEXT+1; /* UP RECORD PTR * 06770000 LA @F,1 0322 06780000 A @F,NEXT 0322 06790000 ST @F,NEXT 0322 06800000 * COUNTER=BYTES-2; /* NO. OF RECORD BYTES LEFT * 06810000 SR @F,@F 0323 06820000 IC @F,BYTES 0323 06830000 SH @F,@D5 0323 06840000 STC @F,COUNTER 0323 06850000 * TBIT(5)='0'B; /* ZERO OUT BIT * 06860000 NI TBIT,B'11110111' 0324 06870000 * GO TO ID4; /* CONTINUE PROCESSING * 06880000 BC 15,ID4 0325 06890000 * END; /* END OF LOOP * 06900000 * ELSE; /* NULL ELSE * 06910000 @9C4 EQU * 0327 06920000 * IF TBIT(4)='1'B /* BIT ON * 06930000 * THEN /* YES * 06940000 @9C3 TM TBIT,B'00010000' 0328 06950000 BC 12,@9C2 0328 06960000 * DO; /* DO LOOP * 06970000 * NUMBS=INFO; /* SAVE DATA LENGTH * 06980000 L @3,NEXT 0330 06990000 MVC NUMBS(1),0(@3) 0330 07000000 * NEXT=NEXT+1; /* INCR PT TO INPUT * 07010000 LA @F,1 0331 07020000 A @F,NEXT 0331 07030000 ST @F,NEXT 0331 07040000 * COUNTER=BYTES-1; /* NO. OF RECORD BYTES * 07050000 SR @F,@F 0332 07060000 IC @F,BYTES 0332 07070000 BCTR @F,0 0332 07080000 STC @F,COUNTER 0332 07090000 * TBIT(4)='0'B; /* ZERO OUT BIT * 07100000 NI TBIT,B'11101111' 0333 07110000 * GO TO ID4; /* CONTINUE PROCESSING * 07120000 BC 15,ID4 0334 07130000 * END; /* END OF LOOP * 07140000 * ELSE; /* NULL ELSE * 07150000 @9C2 EQU * 0336 07160000 * IF TBIT(3)='1'B /* BIT ON * 07170000 * THEN /* YES * 07180000 @9C1 TM TBIT,B'00100000' 0337 07190000 BC 12,@9C0 0337 07200000 * DO; /* DO LOOP * 07210000 * DO A=1 TO COUNTER; /* MOVE REST OF DATA * 07220000 LA @F,1 0339 07230000 BC 15,@DO9BE 0339 07240000 * USINFO=INFO; /* BYTE BY BYTE * 07250000 @DO9BF L @3,NEXT 0340 07260000 L @8,SRT 0340 07270000 MVC 0(1,@8),0(@3) 0340 07280000 * NEXT=NEXT+1; /* UP RECORD PTR * 07290000 LA @F,1 0341 07300000 A @F,NEXT 0341 07310000 ST @F,NEXT 0341 07320000 * SRT=SRT+1; /* UP TABLE PTR * 07330000 LA @F,1 0342 07340000 A @F,SRT 0342 07350000 ST @F,SRT 0342 07360000 * END; /* END OF DO LOOP * 07370000 * COUNTER=BYTES-COUNTER; /* NO. OF RECORD BYTES * 07380000 SR @F,@F 0343 07390000 IC @F,A 0343 07400000 AH @F,@D6 0343 07410000 @DO9BE STC @F,A 0343 07420000 SR @0,@0 0343 07430000 IC @0,COUNTER 0343 07440000 CR @F,@0 0343 07450000 BC 12,@DO9BF 0343 07460000 SR @F,@F 0344 07470000 IC @F,BYTES 0344 07480000 IC @0,COUNTER 0344 07490000 SR @F,@0 0344 07500000 STC @F,COUNTER 0344 07510000 * TBIT(3)='0'B; /* ZERO OUT BIT * 07520000 NI TBIT,B'11011111' 0345 07530000 * GO TO ID5; /* CONTINUE PROCESSING * 07540000 BC 15,ID5 0346 07550000 * END; /* END OF LOOP * 07560000 * ELSE; /* NULL ELSE * 07570000 @9C0 EQU * 0348 07580000 * COUNTER=BYTES; /* NO. OF RECORD BYTES * 07590000 @9BB MVC COUNTER(1),BYTES 0349 07600000 * GO TO IDENRT; /* PROCESS RECORD * 07610000 BC 15,IDENRT 0350 07620000 * END; /* END OF DO LOOP * 07630000 * ELSE; /* NULL ELSE * 07640000 @9D1 EQU * 0352 07650000 @9D2 EQU * 0352 07660000 * SUB2: COUNTER=3; /* SET UP COUNTER FOR DO LOOP * 07670000 @9BA EQU * 0353 07680000 SUB2 MVI COUNTER,3 0353 07690000 * DO A=1 TO COUNTER; /* MOVE IN DATE * 07700000 LA @F,1 0354 07710000 BC 15,@DO9B8 0354 07720000 * USINFO=INFO; /* BYTE BY BYTE * 07730000 @DO9B9 L @3,NEXT 0355 07740000 L @8,SRT 0355 07750000 MVC 0(1,@8),0(@3) 0355 07760000 * NEXT=NEXT+1; /* UP RECORD PTR * 07770000 LA @F,1 0356 07780000 A @F,NEXT 0356 07790000 ST @F,NEXT 0356 07800000 * SRT=SRT+1; /* UP TABLE PTR * 07810000 LA @F,1 0357 07820000 A @F,SRT 0357 07830000 ST @F,SRT 0357 07840000 * END; /* END OF DO LOOP * 07850000 * NUMBS=INFO; /* NUMBER OF DATA BYTES * 07860000 SR @F,@F 0358 07870000 IC @F,A 0358 07880000 AH @F,@D6 0358 07890000 @DO9B8 STC @F,A 0358 07900000 SR @0,@0 0358 07910000 IC @0,COUNTER 0358 07920000 CR @F,@0 0358 07930000 BC 12,@DO9B9 0358 07940000 L @3,NEXT 0359 07950000 MVC NUMBS(1),0(@3) 0359 07960000 * COUNTER=BYTES-4; /* NUMBER OF RECORD BYTES LEFT* 07970000 SR @F,@F 0360 07980000 IC @F,BYTES 0360 07990000 SH @F,@D7 0360 08000000 STC @F,COUNTER 0360 08010000 * NEXT=NEXT+1; /* UP RECORD PTR * 08020000 LA @F,1 0361 08030000 A @F,NEXT 0361 08040000 ST @F,NEXT 0361 08050000 * GO TO ID4; /* CONTINUE PROCESSING * 08060000 BC 15,ID4 0362 08070000 * ZAPRT: NUMBS='0'X; /* ZERO OUT COUNTER * 08080000 ZAPRT MVI NUMBS,X'00' 0363 08090000 * NEXT=INREC+3; /* PTR TO START OF ZAP INFO * 08100000 LA @F,3 0364 08110000 A @F,INREC 0364 08120000 ST @F,NEXT 0364 08130000 * SWITCH(1:8)=FLG(1:8); /* SAVE FLAG BYTE * 08140000 LR @3,@F 0365 08150000 MVC SWITCH(1),0(@3) 0365 08160000 * CSDNXT=CSDPT; /* START OF CESD TABLE * 08170000 MVC CSDNXT(4),CSDPT 0366 08180000 * IF FLG1(2)='1'B /* PREVIOUS ZAP RECORD * 08190000 * THEN /* YES * 08200000 TM FLG1,B'01000000' 0367 08210000 * GO TO ZA; /* CONTINUE PROCESSING * 08220000 BC 01,ZA 0368 08230000 * ELSE /* NO * 08240000 * SRT=SORTOUT; /* START OF SORT TABLE * 08250000 MVC SRT(4),SORTOUT 0369 08260000 * ZA: FLG1=FLG; /* SAVE NUMBER OF ZAPS * 08270000 ZA L @3,NEXT 0370 08280000 MVC FLG1(1),0(@3) 0370 08290000 * FLG1(1:2)='00'B; /* ZERO OUT BITS * 08300000 NI FLG1,B'00111111' 0371 08310000 * COUNTER=FLG1; /* SET UP COUNTER * 08320000 MVC COUNTER(1),FLG1 0372 08330000 * IF COUNTER = 0 /* ANY ZAP ENTRIES * 08340000 * THEN /* NO * 08350000 CLI COUNTER,0 0373 08360000 BC 07,@9B5 0373 08370000 * IF SW1(2)='1'B /* PREVIOUS ZAP RECORD * 08380000 * THEN /* YES * 08390000 TM SW1,B'01000000' 0374 08400000 * GO TO UP1; /* PRINT IT OUT * 08410000 BC 01,UP1 0375 08420000 * ELSE /* NO * 08430000 * GO TO WR1; /* SPECIAL ZAP MESSAGE * 08440000 BC 15,WR1 0376 08450000 * ELSE 08460000 * DO; /* DO LOOP * 08470000 * SW1(2)='1'B; /* ZAP ENTRIES PROCESSED * 08480000 @9B5 OI SW1,B'01000000' 0378 08490000 * NEXT=NEXT+1; /* UP RECORD PTR * 08500000 LA @F,1 0379 08510000 A @F,NEXT 0379 08520000 ST @F,NEXT 0379 08530000 * END; /* END OF DO LOOP * 08540000 * ZAP1: IF IDEN=ESD /* SEARCH FOR MATCHING ESD * 08550000 * THEN /* WHEN FOUND * 08560000 @9B4 EQU * 0381 08570000 ZAP1 L @3,NEXT 0381 08580000 L @8,CSDNXT 0381 08590000 CLC 10(2,@8),0(@3) 0381 08600000 BC 07,@9B3 0381 08610000 * DO; /* DO LOOP * 08620000 * ZPDATE=DATE1; /* SAVE DATE * 08630000 L @6,SRT 0383 08640000 MVC 8(3,@6),2(@3) 0383 08650000 * CNAME=NAME; /* SAVE CSECT NAME * 08660000 MVC 0(8,@6),0(@8) 0384 08670000 * DAZP=ZP; /* SAVE ZAP DATA * 08680000 MVC 11(8,@6),5(@3) 0385 08690000 * NUMBS=NUMBS+1; /* UP THE COUNTER * 08700000 LA @F,1 0386 08710000 SR @0,@0 0386 08720000 IC @0,NUMBS 0386 08730000 AR @F,@0 0386 08740000 STC @F,NUMBS 0386 08750000 * GO TO UPPTR; /* BRANCH OUT * 08760000 BC 15,UPPTR 0387 08770000 * END; /* END OF DO LOOP * 08780000 * ELSE /* NO MATCH * 08790000 * IF CSDNXT^=CSDEND /* ANY MORE CESD ENTRIES? * 08800000 * THEN /* YES * 08810000 @9B3 L @F,CSDEND 0389 08820000 C @F,CSDNXT 0389 08830000 BC 08,@9B1 0389 08840000 * DO; /* DO LOOP * 08850000 * CSDNXT=CSDNXT+12; /* UP CESD TABLE PTR * 08860000 LA @F,12 0391 08870000 A @F,CSDNXT 0391 08880000 ST @F,CSDNXT 0391 08890000 * GO TO ZAP1; /* TRY AGAIN * 08900000 BC 15,ZAP1 0392 08910000 * END; /* END OF DO LOOP * 08920000 * ELSE /* NO MORE ENTRIES * 08930000 * GO TO ERR1; /* CESD ERROR * 08940000 * UPPTR: IF COUNTER=NUMBS /* LAST ZAP ENTRY * 08950000 * THEN /* YES * 08960000 @9B0 EQU * 0395 08970000 @9B2 EQU * 0395 08980000 UPPTR CLC COUNTER(1),NUMBS 0395 08990000 BC 07,@9AF 0395 09000000 * IF SWITCH(2)='1'B /* ANOTHER ZAP RECORD * 09010000 * THEN /* YES * 09020000 TM SWITCH,B'01000000' 0396 09030000 BC 12,@9AE 0396 09040000 * DO; /* DO LOOP * 09050000 * SRTEND=SRT; /* SAVE END OF TABLE ADDR * 09060000 MVC SRTEND(4),SRT 0398 09070000 * SRT=SRT+19; /* INCR TABLE PTR XA1821 * 09080000 LA @F,19 0399 09090000 A @F,SRT 0399 09100000 ST @F,SRT 0399 09110000 * FLG1(2)='1'B; /* PREVIOUS ZAP * 09120000 OI FLG1,B'01000000' 0400 09130000 * GO TO READRT; /* READ NEXT ZAP RECORD * 09140000 BC 15,READRT 0401 09150000 * END; /* END OF DO LOOP * 09160000 * ELSE /* * 09170000 * DO; /* DO LOOP FOR SORTING TABLE * 09180000 * SRTEND=SRT; /* SAVE END OF TABLE ADDR * 09190000 @9AE MVC SRTEND(4),SRT 0404 09200000 * UP1: SRT=SORTOUT; /* START OF TABLE * 09210000 UP1 MVC SRT(4),SORTOUT 0405 09220000 * IF SRT=SRTEND /* END OF TABLE? * 09230000 * THEN /* YES * 09240000 L @F,SRTEND 0406 09250000 C @F,SRT 0406 09260000 BC 07,@9AC 0406 09270000 * DO; /* DO LOOP * 09280000 * CALL PRNT1; /* WRITE HEADER * 09290000 BAL @E,PRNT1 0408 09300000 * GO TO SRT2; /* BRANCH TO PRINT * 09310000 BC 15,SRT2 0409 09320000 * END; /* END OF DO LOOP * 09330000 * ELSE; /* NULL ELSE * 09340000 @9AC EQU * 0411 09350000 * SRTPT=SRT; /* START OF TABLE * 09360000 @9AB MVC SRTPT(4),SRT 0412 09370000 * SORTAREA=SORTAB; /* MOVE FIRST ENTRY * 09380000 L @3,SRT 0413 09390000 MVC SORTAREA(19),0(@3) 0413 09400000 * GO TO SRT1; /* BRANCH TO START SORT * 09410000 BC 15,SRT1 0414 09420000 * END; /* END OF DO LOOP * 09430000 * ELSE /* MORE ZAP DATA * 09440000 * DO; /* DO LOOP * 09450000 * NEXT=NEXT+13; /* UP RECORD PTR * 09460000 @9AF LA @F,13 0417 09470000 A @F,NEXT 0417 09480000 ST @F,NEXT 0417 09490000 * SRT=SRT+19; /* UP TABLE PTR * 09500000 LA @F,19 0418 09510000 A @F,SRT 0418 09520000 ST @F,SRT 0418 09530000 * CSDNXT=CSDPT; /* START OF CESD TABLE * 09540000 MVC CSDNXT(4),CSDPT 0419 09550000 * GO TO ZAP1; /* PROCESS NEXT ZAP DATA * 09560000 BC 15,ZAP1 0420 09570000 * END; /* END OF DO LOOP * 09580000 * SRT1: SRT=SRT+19; /* UP PTR TO SORT TABLE * 09590000 @9AA EQU * 0422 09600000 SRT1 LA @F,19 0422 09610000 A @F,SRT 0422 09620000 ST @F,SRT 0422 09630000 * IF CNAME ^< CSECTNM /* ALPHA SORT CORRECT * 09640000 * THEN /* YES * 09650000 LR @3,@F 0423 09660000 CLC 0(8,@3),SORTAREA 0423 09670000 BC 04,@9A9 0423 09680000 * DO; 09690000 * IF SRT ^= SRTEND /* LAST ENTRY * 09700000 * THEN /* NO * 09710000 L @F,SRTEND 0425 09720000 C @F,SRT 0425 09730000 * GO TO SRT1; /* CONTINUE SORT * 09740000 BC 07,SRT1 0426 09750000 * ELSE /* YES * 09760000 * DO; /* DO LOOP * 09770000 * SRTPT=SRTPT+19; /* NEXT ENTRY * 09780000 LA @F,19 0428 09790000 A @F,SRTPT 0428 09800000 ST @F,SRTPT 0428 09810000 * GO TO SRT3; /* NEXT COMPARE * 09820000 BC 15,SRT3 0429 09830000 * END; /* END OF DO LOOP * 09840000 * END; /* END OF DO LOOP * 09850000 * ELSE /* ALPHA ORDER INCORRECT * 09860000 * DO; /* YES * 09870000 * ZAPSORT=SORTAB; /* SAVE PRESENT TABLE ENTRY * 09880000 @9A9 L @3,SRT 0433 09890000 MVC ZAPSORT(19),0(@3) 0433 09900000 * SORTAB=SORTAREA; /* REPLACE WITH COMPARE ITEM * 09910000 MVC 0(19,@3),SORTAREA 0434 09920000 * SRT=SRTPT; /* REPLACE WITH NEEDED ADDR * 09930000 MVC SRT(4),SRTPT 0435 09940000 * SORTAB=ZAPSORT; /* SWAP TABLE ENTRY * 09950000 L @3,SRT 0436 09960000 MVC 0(19,@3),ZAPSORT 0436 09970000 * SRT3: SRT=SRTPT; /* USE NEW TABLE ENTRY * 09980000 SRT3 MVC SRT(4),SRTPT 0437 09990000 * IF SRTPT = SRTEND /* END OF TABLE * 10000000 * THEN /* * 10010000 L @F,SRTEND 0438 10020000 C @F,SRTPT 0438 10030000 BC 07,@9A7 0438 10040000 * DO; /* DO LOOP * 10050000 * CALL PRNT1; /* WRITE HEADER * 10060000 BAL @E,PRNT1 0440 10070000 * GO TO SRT2; /* BRANCH TO PRINT * 10080000 BC 15,SRT2 0441 10090000 * END; /* END OF DO LOOP * 10100000 * ELSE /* NO * 10110000 * DO; /* * 10120000 * SORTAREA=SORTAB; /* COMPARE ITEM * 10130000 @9A7 L @3,SRT 0444 10140000 MVC SORTAREA(19),0(@3) 0444 10150000 * GO TO SRT1; 10160000 BC 15,SRT1 0445 10170000 * END; /* END OF DO LOOP * 10180000 * END; 10190000 @9A6 EQU * 0447 10200000 * SRT2: IF NUMO > 50 /* LINES > 50? * 10210000 * THEN /* YES * 10220000 @9A8 EQU * 0448 10230000 SRT2 L @3,PARMPTR 0448 10240000 CLI 72(@3),50 0448 10250000 BC 12,@9A5 0448 10260000 * CALL PRNT1; /* WRITE HEADER * 10270000 BAL @E,PRNT1 0449 10280000 * ELSE; /* NULL ELSE * 10290000 @9A5 EQU * 0450 10300000 * SRT=SORTOUT; /* START OF SORT TABLE * 10310000 @9A4 MVC SRT(4),SORTOUT 0451 10320000 * SRT4: NUMO=NUMO+2; /* FOR LINE COUNT * 10330000 SRT4 LA @F,2 0452 10340000 L @3,PARMPTR 0452 10350000 SR @0,@0 0452 10360000 IC @0,72(0,@3) 0452 10370000 AR @F,@0 0452 10380000 STC @F,72(0,@3) 0452 10390000 * ZPPRINT=BLANKS; /* BLANK OUT AREA * 10400000 L @8,OUT 0453 10410000 MVC 0(1,@8),BLANKS 0453 10420000 MVI 1(@8),C' ' 0453 10430000 MVC 2(119,@8),1(@8) 0453 10440000 * USA2 = '0'; /* SKIP TWO LINES * 10450000 MVI 0(@8),C'0' 0454 10460000 * CSNAME = 'CSECT'; /* CSECT * 10470000 MVC 21(5,@8),@C16 0455 10480000 MVI 26(@8),C' ' 0455 10490000 MVC 27(2,@8),26(@8) 0455 10500000 * YEAR = 'YR'; /* YR * 10510000 MVC 49(2,@8),@C17 0456 10520000 * SL = '/'; /* / * 10530000 MVI 51(@8),C'/' 0457 10540000 * DATE = 'DAY'; /* DAY * 10550000 MVC 52(3,@8),@C19 0458 10560000 * ZPD='IMASPZAP'; /* IMASPZAP * 10570000 MVC 75(8,@8),@C20 0459 10580000 * SPCD=' DATA'; /* DATA * 10590000 MVC 83(5,@8),@C21 0460 10600000 MVI 88(@8),C' ' 0460 10610000 MVC 89(32,@8),88(@8) 0460 10620000 * RESTRICT (5,6); /* RESTRICT R5 AND R6 * 10630000 * R5=DCBOUT; /* ADDR OF OUTPUT DCB * 10640000 L @5,4(0,@3) 0462 10650000 * R6=ADDR(ZPPRINT); /* ADDR OF OUTPUT AREA * 10660000 LR @6,@8 0463 10670000 * GEN (PUT (5),(6)); /* PRINT OUTPUT LINE * 10680000 PUT (5),(6) 10690000 DS 0H 10700000 * GO TO WRZAP; /* CONTINUE PRINTOUT * 10710000 BC 15,WRZAP 0465 10720000 * WR: R5=DCBOUT; /* ADDR OF OUTPUT DCB * 10730000 WR L @3,PARMPTR 0466 10740000 L @5,4(0,@3) 0466 10750000 * R6=ADDR(ZPPRINT); /* ADDR OF OUTPUT * 10760000 L @4,OUT 0467 10770000 LR @6,@4 0467 10780000 * GENERATE (PUT (5),(6)); /* PRINT RTN USING BAL MACRO * 10790000 PUT (5),(6) 10800000 DS 0H 10810000 * USA2=' '; /* SINGLE SPACING * 10820000 MVI 0(@4),C' ' 0469 10830000 * NUMO=NUMO+1; /* FOR LINE COUNT * 10840000 LA @F,1 0470 10850000 SR @0,@0 0470 10860000 IC @0,72(0,@3) 0470 10870000 AR @F,@0 0470 10880000 STC @F,72(0,@3) 0470 10890000 * LL=NUMO; /* LAST LINE * 10900000 MVC LL+1(1),72(@3) 0471 10910000 MVI LL,X'00' 0471 10920000 * IF NUMO > 50 /* NUMBER OF LINES > 50? * 10930000 * THEN /* YES * 10940000 CLI 72(@3),50 0472 10950000 BC 12,@9A3 0472 10960000 * DO; /* DO LOOP * 10970000 * CALL PRNT1; /* PRINT NEW HEADER * 10980000 BAL @E,PRNT1 0474 10990000 * GO TO SRT4; /* PRINT NEW TITLE * 11000000 BC 15,SRT4 0475 11010000 * END; /* END OF DO LOOP * 11020000 * ELSE 11030000 * GO TO WRZAP; /* CONTINUE PRINTOUT * 11040000 * WRZAP: SPCD=BLANKS; /* BLANK OUT * 11050000 @9A2 EQU * 0478 11060000 WRZAP L @3,OUT 0478 11070000 MVC 83(1,@3),BLANKS 0478 11080000 MVI 84(@3),C' ' 0478 11090000 MVC 85(36,@3),84(@3) 0478 11100000 * IF SRT > SRTEND /* LAST ENTRY * 11110000 * THEN /* YES * 11120000 L @F,SRTEND 0479 11130000 C @F,SRT 0479 11140000 BC 10,@9A1 0479 11150000 * DO; /* DO LOOP * 11160000 * USA2='0'; /* FOR DOUBLE SPACING * 11170000 MVI 0(@3),C'0' 0481 11180000 * ZPPRINT(2)='-'; /* DASH * 11190000 MVI 1(@3),C'-' 0482 11200000 * ZPPRINT(3:121)=ZPPRINT(2:120); /* PROPAGATE DASHES * 11210000 MVC 2(119,@3),1(@3) 0483 11220000 * NUMO=NUMO+2; /* FOR LINE COUNT * 11230000 LA @F,2 0484 11240000 L @4,PARMPTR 0484 11250000 SR @0,@0 0484 11260000 IC @0,72(0,@4) 0484 11270000 AR @F,@0 0484 11280000 STC @F,72(0,@4) 0484 11290000 * GEN (PUT (5),(6)); 11300000 PUT (5),(6) 11310000 DS 0H 11320000 * GO TO READRT; /* READ NEXT RECORD * 11330000 BC 15,READRT 0486 11340000 * END; /* END OF DO LOOP * 11350000 * ELSE /* NO * 11360000 * DO; /* DO LOOP * 11370000 * CSNAME=CNAME; /* CSECT NAME * 11380000 @9A1 L @3,SRT 0489 11390000 L @4,OUT 0489 11400000 MVC 21(8,@4),0(@3) 0489 11410000 * ZPD=DAZP; /* ZAP DATA * 11420000 MVC 75(8,@4),11(@3) 0490 11430000 * R5=ADDR(ZPDATE); /* ADDR OF DATE * 11440000 LA @5,8(0,@3) 0491 11450000 * R6=ADDR(UNPKAREA); /* ADDR OF UNPACK AREA * 11460000 LA @6,UNPKAREA 0492 11470000 * GENERATE (UNPK 0(5,6),0(3,5)); 11480000 UNPK 0(5,6),0(3,5) 11490000 DS 0H 11500000 * RELEASE (5,6); /* RELEASE RESTRICTION * 11510000 * YEAR=YRZ; /* YR * 11520000 MVC 49(2,@4),UNPKAREA 0495 11530000 * DATE=DYZ; /* DAY * 11540000 MVC 52(3,@4),UNPKAREA+2 0496 11550000 * SRT=SRT+19; /* NEXT TABLE ENTRY * 11560000 LA @F,19 0497 11570000 A @F,SRT 0497 11580000 ST @F,SRT 0497 11590000 * GO TO WR; /* GO TO PRINT OUT * 11600000 BC 15,WR 0498 11610000 * END; /* END OF DO LOOP * 11620000 * WR1: CALL PRNT1; /* PRINT TITLE * 11630000 @9A0 EQU * 0500 11640000 WR1 BAL @E,PRNT1 0500 11650000 * IF MDLB='1'B /* MODLIB SPECIFIED ? * 11660000 * THEN /* YES * 11670000 L @3,PARMPTR 0501 11680000 TM 20(@3),B'00001000' 0501 11690000 * GO TO READRT; /* BYPASS NO ZAP MESSAGE * 11700000 BC 01,READRT 0502 11710000 * ELSE; /* NULL ELSE * 11720000 * NOZAP=BLANKS; /* BLANK OUT AREA * 11730000 L @8,OUT 0504 11740000 MVC 0(1,@8),BLANKS 0504 11750000 MVI 1(@8),C' ' 0504 11760000 MVC 2(119,@8),1(@8) 0504 11770000 * USA6='0'; /* SKIP TWO LINES * 11780000 MVI 0(@8),C'0' 0505 11790000 * ZPMSG1='THIS LOAD MODULE CONTAINS '; 11800000 MVC 26(26,@8),@C23 0506 11810000 * ZPMSG2='NO INFORMATION SUPPLIED BY IMASPZAP'; 11820000 MVC 52(35,@8),@C24 0507 11830000 * RESTRICT (5,6); /* RESTRICT R5 AND R6 * 11840000 * R5=DCBOUT; /* ADDRESS OF OUTPUT DCB * 11850000 L @5,4(0,@3) 0509 11860000 * R6=ADDR(NOZAP); /* ADDRESS OF OUTPUT AREA * 11870000 LR @6,@8 0510 11880000 * GENERATE (PUT (5),(6)); 11890000 PUT (5),(6) 11900000 DS 0H 11910000 * NOZAP(2)='-'; /* DASH * 11920000 MVI 1(@8),C'-' 0512 11930000 * NOZAP(3:121)=NOZAP(2:120); /* PROPAGATE DASHES * 11940000 MVC 2(119,@8),1(@8) 0513 11950000 * GEN(PUT (5),(6)); 11960000 PUT (5),(6) 11970000 DS 0H 11980000 * RELEASE (5,6); /* RELEASE RESTRICTION * 11990000 * NUMO=NUMO+4; /* FOR LINE COUNT * 12000000 LA @F,4 0516 12010000 SR @0,@0 0516 12020000 IC @0,72(0,@3) 0516 12030000 AR @F,@0 0516 12040000 STC @F,72(0,@3) 0516 12050000 * GO TO READRT; 12060000 BC 15,READRT 0517 12070000 * IDENRT: NEXT=INREC+3; /* START OF IDEN DATA * 12080000 IDENRT LA @F,3 0518 12090000 A @F,INREC 0518 12100000 ST @F,NEXT 0518 12110000 * SRT=SORTOUT; /* START OF IDEN TABLE AREA * 12120000 MVC SRT(4),SORTOUT 0519 12130000 * ID3: CSDNXT=CSDPT; /* START OF CESD TABLE * 12140000 ID3 MVC CSDNXT(4),CSDPT 0520 12150000 * IF COUNTER < 6 /* LESS THAN 6 BYTES OF DATA * 12160000 * THEN /* YES * 12170000 CLI COUNTER,6 0521 12180000 * GO TO ID1; /* SAVE THESE BYTES * 12190000 BC 04,ID1 0522 12200000 * ELSE; /* NO * 12210000 * ID2: IF IDEN=ESD4 /* MATCHING ID'S * 12220000 * THEN /* YES * 12230000 ID2 L @3,NEXT 0524 12240000 L @8,CSDNXT 0524 12250000 CLC 10(2,@8),0(@3) 0524 12260000 BC 07,@99F 0524 12270000 * DO; /* DO LOOP * 12280000 * SRTEND=SRT; /* END OF TABLE ADDRESS * 12290000 MVC SRTEND(4),SRT 0526 12300000 * USNAME=NAME; /* SAVE CSECT NAME IN TABLE * 12310000 L @6,SRT 0527 12320000 MVC 0(8,@6),0(@8) 0527 12330000 * USDATE=DATE5; /* SAVE DATE IN TABLE * 12340000 MVC 8(3,@6),2(@3) 0528 12350000 * SRT=SRT+11; /* UP TABLE PTR * 12360000 LA @F,11 0529 12370000 A @F,SRT 0529 12380000 ST @F,SRT 0529 12390000 * NUMBS=CNT; /* NUMBER OF DATA BYTES * 12400000 MVC NUMBS(1),5(@3) 0530 12410000 * NEXT=NEXT+6; /* UP RECORD PTR * 12420000 LA @F,6 0531 12430000 A @F,NEXT 0531 12440000 ST @F,NEXT 0531 12450000 * COUNTER=COUNTER-6; /* NO. OF RECORD BYTES LEFT * 12460000 SR @F,@F 0532 12470000 IC @F,COUNTER 0532 12480000 SH @F,@D8 0532 12490000 STC @F,COUNTER 0532 12500000 * ID4: IF COUNTER ^< NUMBS /* RECORD BYTES ^< DATA BYTES * 12510000 * THEN /* YES * 12520000 ID4 CLC COUNTER(1),NUMBS 0533 12530000 BC 04,@99E 0533 12540000 * DO; /* DO LOOP * 12550000 * DO A=1 TO NUMBS; /* MOVE BYTES LEFT IN RECORD * 12560000 LA @F,1 0535 12570000 BC 15,@DO99C 0535 12580000 * USINFO = INFO; /* BYTE BY BYTE * 12590000 @DO99D L @3,NEXT 0536 12600000 L @8,SRT 0536 12610000 MVC 0(1,@8),0(@3) 0536 12620000 * NEXT=NEXT+1; /* UP RECORD POINTER * 12630000 LA @F,1 0537 12640000 A @F,NEXT 0537 12650000 ST @F,NEXT 0537 12660000 * SRT=SRT+1; /* UP TABLE PTR * 12670000 LA @F,1 0538 12680000 A @F,SRT 0538 12690000 ST @F,SRT 0538 12700000 * END; /* END OF DO LOOP * 12710000 * COUNTER=COUNTER-NUMBS; /* NUMBER OF REC BYTES * 12720000 SR @F,@F 0539 12730000 IC @F,A 0539 12740000 AH @F,@D6 0539 12750000 @DO99C STC @F,A 0539 12760000 SR @0,@0 0539 12770000 IC @0,NUMBS 0539 12780000 CR @F,@0 0539 12790000 BC 12,@DO99D 0539 12800000 SR @F,@F 0540 12810000 IC @F,COUNTER 0540 12820000 IC @0,NUMBS 0540 12830000 SR @F,@0 0540 12840000 STC @F,COUNTER 0540 12850000 * ID5: IF NUMBS=40 /* DATA BYTES LESS THAN 40 * 12860000 * THEN /* YES * 12870000 ID5 CLI NUMBS,40 0541 12880000 * GO TO ID3; /* PROCESS NEXT RECORD ENTRY * 12890000 BC 08,ID3 0542 12900000 * ELSE /* NO * 12910000 * DO; /* DO LOOP * 12920000 * NUMBS=40-NUMBS; /* NUMBER LESS THAN 40 * 12930000 LA @F,40 0544 12940000 SR @0,@0 0544 12950000 IC @0,NUMBS 0544 12960000 SR @F,@0 0544 12970000 STC @F,NUMBS 0544 12980000 * DO A=1 TO NUMBS; /* MOVE IN BLANKS * 12990000 LA @F,1 0545 13000000 BC 15,@DO998 0545 13010000 * USINFO=BLANKS; /* BYTE BY BYTE * 13020000 @DO999 L @3,SRT 0546 13030000 MVC 0(1,@3),BLANKS 0546 13040000 * SRT=SRT+1; /* UP TABLE PTR * 13050000 LA @F,1 0547 13060000 A @F,SRT 0547 13070000 ST @F,SRT 0547 13080000 * END; /* END OF LOOP * 13090000 * GO TO ID3; /* PROCESS NEXT ENTRY * 13100000 SR @F,@F 0548 13110000 IC @F,A 0548 13120000 AH @F,@D6 0548 13130000 @DO998 STC @F,A 0548 13140000 SR @0,@0 0548 13150000 IC @0,NUMBS 0548 13160000 CR @F,@0 0548 13170000 BC 12,@DO999 0548 13180000 BC 15,ID3 0549 13190000 * END; /* END OF DO LOOP * 13200000 * END; /* END OF DO LOOP * 13210000 * ELSE /* NO * 13220000 * DO; /* DO LOOP * 13230000 * DO A=1 TO COUNTER; /* MOVE BYTES LEFT IN RECORD * 13240000 @99E LA @F,1 0553 13250000 BC 15,@DO993 0553 13260000 * USINFO=INFO; /* BYTE BY BYTE * 13270000 @DO994 L @3,NEXT 0554 13280000 L @8,SRT 0554 13290000 MVC 0(1,@8),0(@3) 0554 13300000 * NEXT=NEXT+1; /* UP RECORD PTR * 13310000 LA @F,1 0555 13320000 A @F,NEXT 0555 13330000 ST @F,NEXT 0555 13340000 * SRT=SRT+1; /* UP TABLE PTR * 13350000 LA @F,1 0556 13360000 A @F,SRT 0556 13370000 ST @F,SRT 0556 13380000 * END; /* END OF LOOP * 13390000 * COUNTER=NUMBS-COUNTER; /* NUMBER OF DATA BYTES * 13400000 SR @F,@F 0557 13410000 IC @F,A 0557 13420000 AH @F,@D6 0557 13430000 @DO993 STC @F,A 0557 13440000 SR @0,@0 0557 13450000 IC @0,COUNTER 0557 13460000 CR @F,@0 0557 13470000 BC 12,@DO994 0557 13480000 SR @F,@F 0558 13490000 IC @F,NUMBS 0558 13500000 IC @0,COUNTER 0558 13510000 SR @F,@0 0558 13520000 STC @F,COUNTER 0558 13530000 * /* LEFT FOR THAT ENTRY * 13540000 * TBIT(3)='1'B; /* TURN ON BIT * 13550000 OI TBIT,B'00100000' 0559 13560000 * GO TO READRT; /* READ NEXT RECORD * 13570000 BC 15,READRT 0560 13580000 * END; /* END OF DO LOOP * 13590000 * END; /* END OF DO LOOP * 13600000 * ELSE /* NO * 13610000 * IF CSDNXT ^> CSDEND /* END OF TABLE * 13620000 * THEN /* NO * 13630000 @99F L @F,CSDEND 0563 13640000 C @F,CSDNXT 0563 13650000 BC 04,@98F 0563 13660000 * DO; /* DO LOOP * 13670000 * CSDNXT=CSDNXT+12; /* UP CESD TABLE PTR * 13680000 LA @F,12 0565 13690000 A @F,CSDNXT 0565 13700000 ST @F,CSDNXT 0565 13710000 * GO TO ID2; /* TRY AGAIN * 13720000 BC 15,ID2 0566 13730000 * END; /* END OF DO LOOP * 13740000 * ELSE /* YES - END OF TABLE * 13750000 * GO TO ERR1; /* RETURN WITH ERROR MSG * 13760000 * ID1: IF COUNTER = 0 /* END OF RECORD * 13770000 * THEN /* YES * 13780000 @98E EQU * 0569 13790000 @990 EQU * 0569 13800000 ID1 CLI COUNTER,0 0569 13810000 BC 07,@98D 0569 13820000 * IF TYP='1'B /* LAST IDR RECORD? * 13830000 * THEN /* YES * 13840000 TM TYP,B'10000000' 0570 13850000 BC 12,@98C 0570 13860000 * DO; /* DO LOOP * 13870000 * CALL IDSORT; /* PRINT OUT LAST RECORD * 13880000 BAL @E,IDSORT 0572 13890000 * RETURN; /* RETURN * 13900000 BC 15,@EL01 0573 13910000 * END; /* END OF DO LOOP * 13920000 * ELSE /* NO * 13930000 * DO; /* DO LOOP * 13940000 * TBIT(2)='1'B; /* ZERO OUT BIT * 13950000 @98C OI TBIT,B'01000000' 0576 13960000 * GO TO READRT; /* READ NEXT RECORD * 13970000 BC 15,READRT 0577 13980000 * END; /* END OF DO LOOP * 13990000 * ELSE; /* NO * 14000000 @98D EQU * 0579 14010000 * IF COUNTER=1 /* ONE BYTE LEFT * 14020000 * THEN /* YES * 14030000 @98A CLI COUNTER,1 0580 14040000 BC 07,@989 0580 14050000 * DO; /* DO LOOP * 14060000 * SAV1=INFO; /* SAVE BYTE * 14070000 L @3,NEXT 0582 14080000 MVC IDSAVE(1),0(@3) 0582 14090000 * TBIT(8)='1'B; /* ZERO OUT BIT * 14100000 OI TBIT,B'00000001' 0583 14110000 * GO TO READRT; /* READ NEXT RECORD * 14120000 BC 15,READRT 0584 14130000 * END; /* END OF DO LOOP * 14140000 * ELSE; /* NO * 14150000 @989 EQU * 0586 14160000 * IF COUNTER=2 /* TWO BYTES LEFT * 14170000 * THEN /* YES * 14180000 @988 CLI COUNTER,2 0587 14190000 BC 07,@987 0587 14200000 * DO; /* DO LOOP * 14210000 * POINT=ADDR(IA); /* RETURN ADDRESS * 14220000 LA @F,IA 0589 14230000 ST @F,POINT 0589 14240000 * GO TO RTA; /* FIND MATCHING ID * 14250000 BC 15,RTA 0590 14260000 * IA: TBIT(7)='1'B; /* ZERO OUT BIT * 14270000 IA OI TBIT,B'00000010' 0591 14280000 * SRT=SRT+8; /* UP TABLE TABLE PTR * 14290000 LA @F,8 0592 14300000 A @F,SRT 0592 14310000 ST @F,SRT 0592 14320000 * GO TO READRT; /* READ NEXT RECORD * 14330000 BC 15,READRT 0593 14340000 * END; /* END OF DO LOOP * 14350000 * ELSE; /* NULL ELSE * 14360000 @987 EQU * 0595 14370000 * IF COUNTER=3 /* THREE BYTES LEFT * 14380000 * THEN /* YES * 14390000 @986 CLI COUNTER,3 0596 14400000 BC 07,@985 0596 14410000 * DO; /* DO LOOP * 14420000 * POINT=ADDR(IB); /* RETURN ADDRESS * 14430000 LA @F,IB 0598 14440000 ST @F,POINT 0598 14450000 * GO TO RTA; /* FIND MATCHING ID * 14460000 BC 15,RTA 0599 14470000 * IB: TBIT(6)='1'B; /* TURN ON BIT * 14480000 IB OI TBIT,B'00000100' 0600 14490000 * USDATE(1)=DATE5(1); /* PART OF DATE * 14500000 L @3,NEXT 0601 14510000 L @8,SRT 0601 14520000 MVC 8(1,@8),2(@3) 0601 14530000 * SRT=SRT+9; /* UP TABLE TABLE PTR * 14540000 LA @F,9 0602 14550000 A @F,SRT 0602 14560000 ST @F,SRT 0602 14570000 * GO TO READRT; /* READ NEXT RECORD * 14580000 BC 15,READRT 0603 14590000 * END; /* END OF LOOP * 14600000 * ELSE; /* NULL ELSE * 14610000 @985 EQU * 0605 14620000 * IF COUNTER=4 /* FOUR BYTES LEFT * 14630000 * THEN /* YES * 14640000 @984 CLI COUNTER,4 0606 14650000 BC 07,@983 0606 14660000 * DO; /* DO LOOP * 14670000 * POINT=ADDR(IC); /* RETURN ADDRESS * 14680000 LA @F,IC 0608 14690000 ST @F,POINT 0608 14700000 * GO TO RTA; /* FIND MATCHING ID * 14710000 BC 15,RTA 0609 14720000 * IC: TBIT(5)='1'B; /* TURN ON BIT * 14730000 IC OI TBIT,B'00001000' 0610 14740000 * USDATE(1:2)=DATE5(1:2); /* SAVE DATE IN TABLE * 14750000 L @3,NEXT 0611 14760000 L @8,SRT 0611 14770000 MVC 8(2,@8),2(@3) 0611 14780000 * SRT=SRT+10; /* UP TABLE PTR * 14790000 LA @F,10 0612 14800000 A @F,SRT 0612 14810000 ST @F,SRT 0612 14820000 * GO TO READRT; /* READ NEXT RECORD * 14830000 BC 15,READRT 0613 14840000 * END; /* END OF LOOP * 14850000 * ELSE; /* NO * 14860000 @983 EQU * 0615 14870000 * IF COUNTER=5 /* FIVE BYTES LEFT * 14880000 * THEN /* YES * 14890000 @982 CLI COUNTER,5 0616 14900000 BC 07,@981 0616 14910000 * DO; /* DO LOOP * 14920000 * POINT=ADDR(IE); /* RETURN ADDRESS * 14930000 LA @F,IE 0618 14940000 ST @F,POINT 0618 14950000 * GO TO RTA; /* FIND MATCHING ID * 14960000 BC 15,RTA 0619 14970000 * IE: TBIT(4)='1'B; /* TURN ON BIT * 14980000 IE OI TBIT,B'00010000' 0620 14990000 * USDATE=DATE5; /* SAVE DATE IN TABLE * 15000000 L @3,NEXT 0621 15010000 L @8,SRT 0621 15020000 MVC 8(3,@8),2(@3) 0621 15030000 * NUMBS=CNT; /* NO. OF DATA BYTES * 15040000 MVC NUMBS(1),5(@3) 0622 15050000 * SRT=SRT+11; /* UP TABLE PTR * 15060000 LA @F,11 0623 15070000 A @F,SRT 0623 15080000 ST @F,SRT 0623 15090000 * GO TO READRT; /* READ NEXT RECORD * 15100000 BC 15,READRT 0624 15110000 * END; /* END OF DO LOOP * 15120000 * ELSE; /* NULL ELSE * 15130000 @981 EQU * 0626 15140000 * LKERT: IF NUMO > 48 /* LINE COUNT > 48? * 15150000 * THEN /* YES * 15160000 @980 EQU * 0627 15170000 LKERT L @3,PARMPTR 0627 15180000 CLI 72(@3),48 0627 15190000 BC 12,@97F 0627 15200000 * CALL PRNT1; /* PRINT NEW HEADER * 15210000 BAL @E,PRNT1 0628 15220000 * ELSE; /* NULL ELSE * 15230000 @97F EQU * 0629 15240000 * IF MDLB='1'B /* MODLIB SPECIFIED * 15250000 * THEN /* YES * 15260000 @97E L @3,PARMPTR 0630 15270000 TM 20(@3),B'00001000' 0630 15280000 * GO TO LKERT1; /* BYPASS PRINTOUT * 15290000 BC 01,LKERT1 0631 15300000 * ELSE; /* NULL ELSE * 15310000 * LINKOUT=BLANKS; /* BLANK OUT * 15320000 L @8,OUT 0633 15330000 MVC 0(1,@8),BLANKS 0633 15340000 MVI 1(@8),C' ' 0633 15350000 MVC 2(119,@8),1(@8) 0633 15360000 * USA4='0'; /* SKIP TWO LINES * 15370000 MVI 0(@8),C'0' 0634 15380000 * MSG1='THIS LOAD MODULE WAS PRODUCED BY LINKAGE EDITOR '; 15390000 MVC 10(48,@8),@C25 0635 15400000 * MSG2=PROGNM; /* PROGRAM NAME * 15410000 L @6,INREC 0636 15420000 MVC 58(10,@8),3(@6) 0636 15430000 * SP10=' AT LEVEL '; /* CONTINUE MESSAGE * 15440000 MVC 68(10,@8),@C26 0637 15450000 * RESTRICT (5,6); /* RESTRICT R5 AND R6 * 15460000 * R5=ADDR(VRSION); /* ADDRESS OF PACKED DATA * 15470000 L @4,INREC 0639 15480000 LA @5,13(0,@4) 0639 15490000 * R6=ADDR(UPAK2); /* ADDRESS OF UNPACK AREA * 15500000 LA @6,UPAK2 0640 15510000 * GENERATE (UNPK 0(5,6),0(3,5)); 15520000 UNPK 0(5,6),0(3,5) 15530000 DS 0H 15540000 * MSG3A=UPK1; /* VERSION * 15550000 MVC 78(2,@8),UPAK2 0642 15560000 * MSG3B='.'; /* SLASH * 15570000 MVI 80(@8),C'.' 0643 15580000 * MSG3C=UPK2; /* MOD * 15590000 MVC 81(2,@8),UPAK2+2 0644 15600000 * R5=ADDR(LKDATE); /* ADDRESS OF PACKED DATA * 15610000 LA @5,15(0,@4) 0645 15620000 * R6=ADDR(UNPKAREA); /* ADDRESS OF UNPACK AREA * 15630000 LA @6,UNPKAREA 0646 15640000 * GENERATE (UNPK 0(5,6),0(3,5)); 15650000 UNPK 0(5,6),0(3,5) 15660000 DS 0H 15670000 * SP8=' ON DAY '; /* CONTINUE MESSAGE * 15680000 MVC 83(8,@8),@C28 0648 15690000 * MSG4=DYZ; /* DAY * 15700000 MVC 91(3,@8),UNPKAREA+2 0649 15710000 * SP9=' OF YEAR '; /* CONTINUE MESSAGE * 15720000 MVC 94(9,@8),@C29 0650 15730000 * MSG5=YRZ; /* YEAR * 15740000 MVC 103(2,@8),UNPKAREA 0651 15750000 * DOT='.'; /* . * 15760000 MVI 105(@8),C'.' 0652 15770000 * R5=DCBOUT; /* ADDR OF OUTPUT DCB * 15780000 L @5,4(0,@3) 0653 15790000 * R6=ADDR(LINKOUT); /* ADDR OF OUTPUT PRINT AREA * 15800000 LR @6,@8 0654 15810000 * GENERATE (PUT (5),(6)); 15820000 PUT (5),(6) 15830000 DS 0H 15840000 * LINKOUT(2)='-'; /* DASH * 15850000 MVI 1(@8),C'-' 0656 15860000 * LINKOUT(3:121)=LINKOUT(2:120); /* PROPAGATE DASHES * 15870000 MVC 2(119,@8),1(@8) 0657 15880000 * GEN(PUT (5),(6)); 15890000 PUT (5),(6) 15900000 DS 0H 15910000 * RELEASE (5,6); /* RELEASE RESTRICTION * 15920000 * NUMO=NUMO+4; /* FOR LINE COUNT * 15930000 LA @F,4 0660 15940000 SR @0,@0 0660 15950000 IC @0,72(0,@3) 0660 15960000 AR @F,@0 0660 15970000 STC @F,72(0,@3) 0660 15980000 * LKERT1: IF TYP='1'B /* LAST IDR * 15990000 * THEN /* YES * 16000000 LKERT1 TM TYP,B'10000000' 0661 16010000 * RETURN; /* RETURN * 16020000 BC 03,@EL01 0662 16030000 * ELSE /* NO * 16040000 * GO TO READRT; /* READ NEXT RECORD * 16050000 BC 15,READRT 0663 16060000 * TRANSRT: CSDNXT=CSDPT; /* START OF CESD TABLE * 16070000 @97C EQU * 0664 16080000 TRANSRT MVC CSDNXT(4),CSDPT 0664 16090000 * SRT=SORTOUT; /* START OF SORT TABLE * 16100000 MVC SRT(4),SORTOUT 0665 16110000 * NEXT=INREC+3; /* BEGINNING OF TRANS * 16120000 LA @F,3 0666 16130000 A @F,INREC 0666 16140000 ST @F,NEXT 0666 16150000 * TRN=TRNOUT; /* FOR TRANS DATA * 16160000 MVC TRN(4),TRNOUT 0667 16170000 * TR1: IF COUNTER=0 /* ANY BYTES LEFT? * 16180000 * THEN /* NO * 16190000 TR1 CLI COUNTER,0 0668 16200000 * GO TO RET; /* NEXT RECORD CHECK * 16210000 BC 08,RET 0669 16220000 * ELSE /* YES * 16230000 * IF TBIT(8)='1'B /* ANOTHER TRANSLATOR * 16240000 * THEN /* YES * 16250000 TM TBIT,B'00000001' 0670 16260000 BC 12,@97B 0670 16270000 * DO; /* DO LOOP * 16280000 * TBIT(8)='0'B; /* ZERO OUT BIT * 16290000 NI TBIT,B'11111110' 0672 16300000 * GO TO TR3; /* CONTINUE PROCESSING * 16310000 BC 15,TR3 0673 16320000 * END; /* END OF DO LOOP * 16330000 * ELSE; /* NULL ELSE * 16340000 @97B EQU * 0675 16350000 * IDSAVE=ESDBITS; /* ESDID * 16360000 @97A L @3,NEXT 0676 16370000 MVC IDSAVE(2),0(@3) 0676 16380000 * COUNTER=COUNTER-2; /* SUBTRACT 2 FROM BYTE COUNT * 16390000 SR @F,@F 0677 16400000 IC @F,COUNTER 0677 16410000 SH @F,@D5 0677 16420000 STC @F,COUNTER 0677 16430000 * TR1B: IF IDSAVE(1)='1'B /* LAST ID BEFORE TRANS DESCR * 16440000 * THEN /* YES * 16450000 TR1B TM IDSAVE,B'10000000' 0678 16460000 BC 12,@979 0678 16470000 * DO; /* DO LOOP * 16480000 * IDSAVE(1)='0'B; /* TURN OFF BIT * 16490000 NI IDSAVE,B'01111111' 0680 16500000 * POINT=ADDR(TA); /* RETURN ADDRESS * 16510000 LA @F,TA 0681 16520000 ST @F,POINT 0681 16530000 * GO TO CSFIND; /* FIND MATCHING ID * 16540000 BC 15,CSFIND 0682 16550000 * TA: TRNTAB=BLANKS; /* BLANK OUT NEXT TABLE ENTRY * 16560000 TA L @3,SRT 0683 16570000 MVC 0(1,@3),BLANKS 0683 16580000 MVI 1(@3),C' ' 0683 16590000 MVC 2(6,@3),1(@3) 0683 16600000 * SRT=SRT+8; /* UP TABLE PTR * 16610000 LA @F,8 0684 16620000 A @F,SRT 0684 16630000 ST @F,SRT 0684 16640000 * IF COUNTER=0 /* ANY BYTES LEFT IN RECORD * 16650000 * THEN /* NO * 16660000 CLI COUNTER,0 0685 16670000 BC 07,@978 0685 16680000 * DO; /* DO LOOP * 16690000 * TBIT(7)='1'B; /* NEXT RECORD - TRANS DESCRIP* 16700000 OI TBIT,B'00000010' 0687 16710000 * GO TO READRT; /* NEXT RECORD CHECK * 16720000 BC 15,READRT 0688 16730000 * END; /* END OF DO LOOP * 16740000 * ELSE; /* YES * 16750000 @978 EQU * 0690 16760000 * TR1A: TBIT=SPBIT; /* NO. OF TRANSLATORS * 16770000 @977 EQU * 0691 16780000 TR1A L @3,NEXT 0691 16790000 MVC TBIT(1),0(@3) 0691 16800000 * NEXT=NEXT+1; /* UP RECORD PTR * 16810000 LA @F,1 0692 16820000 A @F,NEXT 0692 16830000 ST @F,NEXT 0692 16840000 * COUNTER=COUNTER-1; /* SUBTRACT INDIC BYTE * 16850000 SR @F,@F 0693 16860000 IC @F,COUNTER 0693 16870000 BCTR @F,0 0693 16880000 STC @F,COUNTER 0693 16890000 * IF COUNTER < 15 /* PARTIAL TRANS DESCRIP * 16900000 * THEN /* YES * 16910000 CLI COUNTER,15 0694 16920000 BC 10,@976 0694 16930000 * DO; /* DO LOOP * 16940000 * POINT=ADDR(B3); /* LINK ADDR * 16950000 LA @F,B3 0696 16960000 ST @F,POINT 0696 16970000 * GO TO SP1; /* BYTE BY BYTE MOVE * 16980000 BC 15,SP1 0697 16990000 * B3: TBIT(6)='1'B; /* NEXT RECORD - TRANS CONTIN.* 17000000 B3 OI TBIT,B'00000100' 0698 17010000 * COUNTER=15-COUNTER; /* BYTES LEFT TO BE MOVED * 17020000 LA @F,15 0699 17030000 SR @0,@0 0699 17040000 IC @0,COUNTER 0699 17050000 SR @F,@0 0699 17060000 STC @F,COUNTER 0699 17070000 * GO TO READRT; /* NEXT RECORD CHECK * 17080000 BC 15,READRT 0700 17090000 * END; /* END OF DO LOOP * 17100000 * ELSE /* NO * 17110000 * GO TO TR2; /* SAVE TRANS INFO * 17120000 * END; /* END OF DO LOOP * 17130000 * ELSE /* MORE ID'S TO FOLLOW * 17140000 * DO; /* DO LOOP * 17150000 * POINT=ADDR(TR4); /* RETURN ADDRESS * 17160000 @979 LA @F,TR4 0705 17170000 ST @F,POINT 0705 17180000 * GO TO CSFIND; /* FIND MATCHING ID * 17190000 BC 15,CSFIND 0706 17200000 * TR4: IF COUNTER <2 /* POSSIBLE PARTIAL ID * 17210000 * THEN /* YES * 17220000 TR4 CLI COUNTER,2 0707 17230000 BC 10,@973 0707 17240000 * IF COUNTER = 0 /* WHOLE ID ON NEXT RECORD * 17250000 * THEN /* YES * 17260000 CLI COUNTER,0 0708 17270000 BC 07,@972 0708 17280000 * DO; /* DO LOOP * 17290000 * TBIT(1)='1'B; /* FOR NEXT RECORD - ID * 17300000 OI TBIT,B'10000000' 0710 17310000 * GO TO READRT; /* NEXT RECORD CHECK * 17320000 BC 15,READRT 0711 17330000 * END; /* END OF DO LOOP * 17340000 * ELSE /* NO * 17350000 * DO; /* DO LOOP * 17360000 * SAV1=SPBIT; /* SPECIAL SAVE AREA * 17370000 @972 L @3,NEXT 0714 17380000 MVC IDSAVE(1),0(@3) 0714 17390000 * TBIT(4)='1'B; /* NEXT RECORD - ID CONTIN. * 17400000 OI TBIT,B'00010000' 0715 17410000 * GO TO READRT; /* NEXT RECORD CHECK * 17420000 BC 15,READRT 0716 17430000 * END; /* END OF DO LOOP * 17440000 * ELSE /* COUNTER ^< 2 * 17450000 * GO TO TR1; /* CONTINUE REGULAR PROCESSING* 17460000 * END; /* END OF DO LOOP * 17470000 @970 EQU * 0719 17480000 * TR2: TPROG=PGM; /* SAVE TRANSLATOR NAME * 17490000 @974 EQU * 0720 17500000 TR2 L @3,NEXT 0720 17510000 L @8,TRN 0720 17520000 MVC 0(10,@8),0(@3) 0720 17530000 * TVER=VRMOD; /* VERSION * 17540000 MVC 10(2,@8),10(@3) 0721 17550000 * TDATE=CMPLE; /* COMPILE DATE * 17560000 MVC 12(3,@8),12(@3) 0722 17570000 * TRN=TRN+15; /* UP TRANS DATA TABLE PTR * 17580000 LA @F,15 0723 17590000 A @F,TRN 0723 17600000 ST @F,TRN 0723 17610000 * COUNTER=COUNTER-15; /* SUBTRACT BYTES PROCESSED * 17620000 SR @F,@F 0724 17630000 IC @F,COUNTER 0724 17640000 SH @F,@D3 0724 17650000 STC @F,COUNTER 0724 17660000 * IF COUNTER =0 /* ANY BYTES LEFT * 17670000 * THEN /* NO * 17680000 CLI COUNTER,0 0725 17690000 BC 07,@96F 0725 17700000 * IF TBIT(8)='0'B /* ANOTHER TRANSL EXPECTED * 17710000 * THEN /* NO * 17720000 TM TBIT,B'00000001' 0726 17730000 BC 05,@96E 0726 17740000 * IF TYP(1)='1'B /* LAST IDR? * 17750000 * THEN /* YES * 17760000 TM TYP,B'10000000' 0727 17770000 BC 12,@96D 0727 17780000 * DO; /* DO LOOP * 17790000 * TDTAB=BLANKS; /* BLANK OUT NEXT TABLE ENTRY * 17800000 L @8,TRN 0729 17810000 MVC 0(1,@8),BLANKS 0729 17820000 MVI 1(@8),C' ' 0729 17830000 MVC 2(13,@8),1(@8) 0729 17840000 * SRTEND=SRT; /* END OF TABLE * 17850000 MVC SRTEND(4),SRT 0730 17860000 * CALL TRSORT; /* PRINT OUT LAST RECORD * 17870000 BAL @E,TRSORT 0731 17880000 * RETURN; /* RETURN * 17890000 BC 15,@EL01 0732 17900000 * END; /* END OF DO LOOP * 17910000 * ELSE /* MORE IDRS * 17920000 * DO; /* DO LOOP * 17930000 * TBIT(1)='1'B; /* TRANSLATOR RECORD CHECK * 17940000 @96D OI TBIT,B'10000000' 0735 17950000 * TDTAB=BLANKS; /* BLANK OUT NEXT TABLE ENTRY * 17960000 L @3,TRN 0736 17970000 MVC 0(1,@3),BLANKS 0736 17980000 MVI 1(@3),C' ' 0736 17990000 MVC 2(13,@3),1(@3) 0736 18000000 * TRN=TRN+15; /* UP TRANS DATA TABLE PTR * 18010000 LA @F,15 0737 18020000 A @F,TRN 0737 18030000 ST @F,TRN 0737 18040000 * SRTEND=SRT; /* SAVE END OF TABLE ADDR * 18050000 MVC SRTEND(4),SRT 0738 18060000 * GO TO READRT; /* READ NEXT RECORD * 18070000 BC 15,READRT 0739 18080000 * END; /* END OF DO LOOP * 18090000 * ELSE /* ANOTHER TRANSLATOR - YES * 18100000 * DO; /* DO LOOP * 18110000 * TBIT(8)='0'B; /* TURN OFF BIT * 18120000 @96E NI TBIT,B'11111110' 0742 18130000 * TBIT(3)='1'B; /* TRANSL REC CONTIN. MIDPT * 18140000 OI TBIT,B'00100000' 0743 18150000 * GO TO READRT; /* NEXT RECORD CHECK * 18160000 BC 15,READRT 0744 18170000 * END; /* END OF DO LOOP * 18180000 * ELSE /* MORE ENTRIES * 18190000 * NEXT=NEXT+15; /* UP RECORD PTR * 18200000 @96F LA @F,15 0746 18210000 A @F,NEXT 0746 18220000 ST @F,NEXT 0746 18230000 * IF TBIT(8)='1'B /* ANOTHER TRANSL EXPECTED * 18240000 * THEN /* YES * 18250000 @96A TM TBIT,B'00000001' 0747 18260000 BC 12,@969 0747 18270000 * DO; /* DO LOOP * 18280000 * TBIT(8)='0'B; /* TURN OFF BIT * 18290000 NI TBIT,B'11111110' 0749 18300000 * IF COUNTER < 15 /* INCOMPLETE DESCRIPTION * 18310000 * THEN /* YES * 18320000 CLI COUNTER,15 0750 18330000 BC 10,@968 0750 18340000 * DO; /* DO LOOP * 18350000 * POINT=ADDR(B4); /* LINK ADDR * 18360000 LA @F,B4 0752 18370000 ST @F,POINT 0752 18380000 * GO TO SP1; /* BYTE MOVE * 18390000 BC 15,SP1 0753 18400000 * B4: COUNTER=15-COUNTER; /* NO. OF BYTES LEFT TO MOVE* 18410000 B4 LA @F,15 0754 18420000 SR @0,@0 0754 18430000 IC @0,COUNTER 0754 18440000 SR @F,@0 0754 18450000 STC @F,COUNTER 0754 18460000 * TBIT(6)='1'B; /* * 18470000 OI TBIT,B'00001100' 0755 18480000 * TBIT(5)='1'B; /* IND 2ND XLATOR SPLIT @ZA03924 * 18490000 * GO TO READRT; /* NEXT RECORD CHECK * 18500000 BC 15,READRT 0757 18510000 * END; /* END OF DO LOOP * 18520000 * ELSE /* COMPLETE TRANS DESCRIP * 18530000 * TR3: DO; /* DO LOOP * 18540000 @968 EQU * 0759 18550000 * TPROG=PGM; /* SAVE PROGRAM NAME OF TRANS * 18560000 TR3 L @3,NEXT 0760 18570000 L @8,TRN 0760 18580000 MVC 0(10,@8),0(@3) 0760 18590000 * TVER=VRMOD; /* VERSION * 18600000 MVC 10(2,@8),10(@3) 0761 18610000 * TDATE=CMPLE; /* DATE OF COMPILE * 18620000 MVC 12(3,@8),12(@3) 0762 18630000 * TRN=TRN+15; /* UP TRANS DATA TABLE PTR * 18640000 LA @F,15 0763 18650000 A @F,TRN 0763 18660000 ST @F,TRN 0763 18670000 * COUNTER=COUNTER-15; /* SUBTRACT BYTES MOVED * 18680000 SR @F,@F 0764 18690000 IC @F,COUNTER 0764 18700000 SH @F,@D3 0764 18710000 STC @F,COUNTER 0764 18720000 * NEXT=NEXT+15; /* UP RECORD PTR * 18730000 LA @F,15 0765 18740000 A @F,NEXT 0765 18750000 ST @F,NEXT 0765 18760000 * IF COUNTER=0 /* ANY BYTES LEFT * 18770000 * THEN /* NO * 18780000 CLI COUNTER,0 0766 18790000 BC 07,@966 0766 18800000 * DO; /* DO LOOP * 18810000 * SRTEND=SRT; /* END OF TABLE * 18820000 MVC SRTEND(4),SRT 0768 18830000 * TBIT(1)='1'B; /* TRANSLATOR RECORD BIT * 18840000 OI TBIT,B'10000000' 0769 18850000 * GO TO RET; /* NEXT RECORD CHECK * 18860000 BC 15,RET 0770 18870000 * END; /* END OF LOOP * 18880000 * ELSE /* BYTES LEFT - YES * 18890000 * GO TO TR4; /* NEXT ID CHECK * 18900000 * END; /* END OF DO LOOP * 18910000 * END; /* END OF DO LOOP * 18920000 * ELSE /* NO MORE TRANSLATORS * 18930000 * DO; /* DO LOOP * 18940000 @969 EQU * 0775 18950000 * TDTAB=BLANKS; /* BLANK OUT NEXT TABLE ENTRY * 18960000 L @3,TRN 0776 18970000 MVC 0(1,@3),BLANKS 0776 18980000 MVI 1(@3),C' ' 0776 18990000 MVC 2(13,@3),1(@3) 0776 19000000 * TRN=TRN+15; /* UP TRANS DATA TABLE PTR * 19010000 LA @F,15 0777 19020000 A @F,TRN 0777 19030000 ST @F,TRN 0777 19040000 * GO TO TR4; /* NEXT ID CHECK * 19050000 BC 15,TR4 0778 19060000 * END; /* END OF DO LOOP * 19070000 * SP1: DO A=1 TO COUNTER; /* SPECIAL BYTE MOVE * 19080000 @964 EQU * 0780 19090000 SP1 LA @F,1 0780 19100000 BC 15,@DO962 0780 19110000 * SPBYT=SPBIT; /* BYTE BY BYTE * 19120000 @DO963 L @3,NEXT 0781 19130000 L @8,TRN 0781 19140000 MVC 0(1,@8),0(@3) 0781 19150000 * NEXT=NEXT+1; /* UP RECORD PTR * 19160000 LA @F,1 0782 19170000 A @F,NEXT 0782 19180000 ST @F,NEXT 0782 19190000 * TRN=TRN+1; /* UP DATA TABLE PTR * 19200000 LA @F,1 0783 19210000 A @F,TRN 0783 19220000 ST @F,TRN 0783 19230000 * END; /* END OF DO LOOP * 19240000 * GO TO LAB1; /* BRANCH ADDRESS * 19250000 SR @F,@F 0784 19260000 IC @F,A 0784 19270000 AH @F,@D6 0784 19280000 @DO962 STC @F,A 0784 19290000 SR @0,@0 0784 19300000 IC @0,COUNTER 0784 19310000 CR @F,@0 0784 19320000 BC 12,@DO963 0784 19330000 L @3,POINT 0785 19340000 BCR 15,@3 0785 19350000 * RET: IF TYP='1'B /* LAST IDR * 19360000 * THEN /* YES * 19370000 RET TM TYP,B'10000000' 0786 19380000 BC 12,@95F 0786 19390000 * DO; /* DO LOOP * 19400000 * CALL TRSORT; /* PRINT OUT TRANS RECORD * 19410000 BAL @E,TRSORT 0788 19420000 * RETURN; /* RETURN * 19430000 BC 15,@EL01 0789 19440000 * END; /* END OF DO LOOP * 19450000 * ELSE /* NO * 19460000 * GO TO READRT; /* READ NEXT RECORD * 19470000 * ERR1: ERRORS(14)='1'B; /* CESD ERROR BIT * 19480000 @95E EQU * 0792 19490000 ERR1 L @3,PARMPTR 0792 19500000 OI 33(@3),B'00000100' 0792 19510000 * RETURN; /* RETURN * 19520000 BC 15,@EL01 0793 19530000 * ERR2: IF MDLB='1'B /* MODLIB SPECIFIED * 19540000 * THEN /* YES * 19550000 ERR2 L @3,PARMPTR 0794 19560000 TM 20(@3),B'00001000' 0794 19570000 BC 12,@95D 0794 19580000 * DO; 19590000 * CALL PRNT1; /* PRINT LOAD MODULE NAME * 19600000 BAL @E,PRNT1 0796 19610000 * GO TO BYMSG; /* BYPASS ERR MSG * 19620000 BC 15,BYMSG 0797 19630000 * END; 19640000 * ELSE; /* NO,SET TO PRINT MSG * 19650000 @95D EQU * 0799 19660000 * ERRORS(12)='1'B; /* NO IDR INFORMATION * 19670000 @95C L @3,PARMPTR 0800 19680000 OI 33(@3),B'00010000' 0800 19690000 * BYMSG: RETURN; /* RETURN * 19700000 BC 15,@EL01 0801 19710000 * ERR3: ERRORS(13)='1'B; /* IDRS INCOMPLETE * 19720000 ERR3 L @3,PARMPTR 0802 19730000 OI 33(@3),B'00001000' 0802 19740000 * RETURN; /* RETURN * 19750000 BC 15,@EL01 0803 19760000 * CSFIND: CSDNXT=CSDPT; /* START OF CESD TABLE * 19770000 CSFIND MVC CSDNXT(4),CSDPT 0804 19780000 * CS1: IF IDEN=IDSAVE /* MATCHING ID * 19790000 * THEN /* YES * 19800000 CS1 L @3,CSDNXT 0805 19810000 CLC 10(2,@3),IDSAVE 0805 19820000 BC 07,@95B 0805 19830000 * DO; /* DO LOOP * 19840000 * TNAME=NAME; /* CSECT NAME * 19850000 L @8,SRT 0807 19860000 MVC 0(8,@8),0(@3) 0807 19870000 * NONAME: SRT=SRT+8; /* UP TABLE PTR @ZA09119 * 19880000 NONAME LA @F,8 0808 19890000 A @F,SRT 0808 19900000 ST @F,SRT 0808 19910000 * IF TBIT(4)='1'B /* SPLIT ID? * 19920000 * THEN /* YES * 19930000 TM TBIT,B'00010000' 0809 19940000 BC 12,@95A 0809 19950000 * TBIT(4)='0'B; /* ZERO OUT BIT * 19960000 NI TBIT,B'11101111' 0810 19970000 BC 15,@959 0811 19980000 * ELSE /* NO * 19990000 * NEXT=NEXT+2; /* UP RECORD PTR * 20000000 @95A LA @F,2 0811 20010000 A @F,NEXT 0811 20020000 ST @F,NEXT 0811 20030000 * GO TO LAB1; /* RETURN * 20040000 @959 L @3,POINT 0812 20050000 BCR 15,@3 0812 20060000 * END; /* END OF DO LOOP * 20070000 * ELSE /* NO MATCH * 20080000 * IF CSDNXT ^= CSDEND /* END OF TABLE? * 20090000 * THEN /* NO * 20100000 @95B L @F,CSDEND 0814 20110000 C @F,CSDNXT 0814 20120000 BC 08,@957 0814 20130000 * DO; /* DO LOOP * 20140000 * CSDNXT=CSDNXT+12; /* UP CESD PTR * 20150000 LA @F,12 0816 20160000 A @F,CSDNXT 0816 20170000 ST @F,CSDNXT 0816 20180000 * GO TO CS1; /* TRY AGAIN * 20190000 BC 15,CS1 0817 20200000 * END; /* END OF DO LOOP * 20210000 * ELSE /* END OF TABLE * 20220000 * TNAME='MISSING'; /* NAME NOT FOUND @ZA09119 * 20230000 @957 L @3,SRT 0819 20240000 MVC 0(7,@3),@C30 0819 20250000 MVI 7(@3),C' ' 0819 20260000 * GO TO NONAME; /* PUT IN SRT FIELD @ZA09119 * 20270000 BC 15,NONAME 0820 20280000 * RTA: CSDNXT=CSDPT; /* START OF CESD TABLE * 20290000 RTA MVC CSDNXT(4),CSDPT 0821 20300000 * RTA1: IF IDEN=ESD4 /* MATCHING ID'S * 20310000 * THEN /* YES * 20320000 RTA1 L @3,NEXT 0822 20330000 L @8,CSDNXT 0822 20340000 CLC 10(2,@8),0(@3) 0822 20350000 BC 07,@955 0822 20360000 * DO; /* DO LOOP * 20370000 * SRTEND=SRT; /* END OF TABLE ADDRESS * 20380000 MVC SRTEND(4),SRT 0824 20390000 * USNAME=NAME; /* MOVE NAME INTO TABLE * 20400000 L @6,SRT 0825 20410000 MVC 0(8,@6),0(@8) 0825 20420000 * GO TO LAB1; /* RETURN * 20430000 L @7,POINT 0826 20440000 BCR 15,@7 0826 20450000 * END; /* END OF DO LOOP * 20460000 * ELSE /* NO * 20470000 * IF CSDNXT ^> CSDEND /* END OF TABLE * 20480000 * THEN /* NO * 20490000 @955 L @F,CSDEND 0828 20500000 C @F,CSDNXT 0828 20510000 BC 04,@953 0828 20520000 * DO; /* DO LOOP * 20530000 * CSDNXT=CSDNXT+12; /* UP CESD TABLE PTR * 20540000 LA @F,12 0830 20550000 A @F,CSDNXT 0830 20560000 ST @F,CSDNXT 0830 20570000 * GO TO RTA1; 20580000 BC 15,RTA1 0831 20590000 * END; /* END OF DO LOOP * 20600000 * ELSE /* YES * 20610000 * GO TO ERR1; /* CESD ERROR * 20620000 * /************************************************************ 20630000 * /* GENERAL PRINT ROUTINE FOR TITLES * 20640000 * /************************************************************ 20650000 * PRNT1: PROCEDURE; 20660000 @952 EQU * 0834 20670000 @954 EQU * 0834 20680000 @EL01 L @D,4(0,@D) 0834 20690000 LR @1,@C 0834 20700000 L @0,@SIZ001 0834 20710000 FREEMAIN R,LV=(0),A=(1) 0834 20720000 L @E,12(0,@D) 0834 20730000 LM @0,@C,20(@D) 0834 20740000 BCR 15,@E 0834 20750000 PRNT1 STM @E,@C,12(@D) 0834 20760000 ST @D,@SAV002+4 0834 20770000 LA @F,@SAV002 0834 20780000 ST @F,8(0,@D) 0834 20790000 LR @D,@F 0834 20800000 * PAGE=BLANKS; /* BLANK OUT PRINT AREA * 20810000 L @1,OUT 0835 20820000 MVC 0(1,@1),BLANKS 0835 20830000 MVI 1(@1),C' ' 0835 20840000 MVC 2(119,@1),1(@1) 0835 20850000 * TITLE='LISTIDR'; /* TITLE * 20860000 MVC 44(7,@1),@C31 0836 20870000 * TIT2=' FOR LOAD MODULE '; /* HEADING CONTINUED * 20880000 MVC 51(17,@1),@C32 0837 20890000 * MEM=MEMNAME; /* MEMBER NAME * 20900000 L @8,PARMPTR 0838 20910000 MVC 68(8,@1),36(@8) 0838 20920000 * 20930000 * /* IF MODLIB SPECIFIED THEN CONDENSE LISTING * 20940000 * IF MDLB='1'B /* MODLIB SPECIFIED * 20950000 * THEN /* YES * 20960000 TM 20(@8),B'00001000' 0839 20970000 BC 12,@951 0839 20980000 * DO; 20990000 * IF NUMO > 48 /* LINE COUNT GREATER THAN 48 * 21000000 * THEN /* YES * 21010000 CLI 72(@8),48 0841 21020000 BC 12,@950 0841 21030000 * DO; 21040000 * USA3='1'; /* SKIP TO TOP OF PAGE * 21050000 MVI 0(@1),C'1' 0843 21060000 * NUMO='00'X; /* ZERO OUT COUNTER * 21070000 MVI 72(@8),X'00' 0844 21080000 * GO TO BYPNT; /* BYPASS PAGE NUMBER * 21090000 BC 15,BYPNT 0845 21100000 * END; 21110000 * ELSE; /* LINE COUNT NOT GT 48 * 21120000 @950 EQU * 0847 21130000 * USA3=' '; /* SKIP ONE LINE * 21140000 @94F L @1,OUT 0848 21150000 MVI 0(@1),C' ' 0848 21160000 * NUMO=NUMO+2; /* INCREASE LINE COUNT BY 2 * 21170000 LA @F,2 0849 21180000 L @8,PARMPTR 0849 21190000 SR @0,@0 0849 21200000 IC @0,72(0,@8) 0849 21210000 AR @F,@0 0849 21220000 STC @F,72(0,@8) 0849 21230000 * GO TO BYPNT; /* BYPASS PAGE NO. AND SKIP * 21240000 BC 15,BYPNT 0850 21250000 * END; 21260000 * ELSE; /* NO,GIVE NORMAL LISTING * 21270000 @951 EQU * 0852 21280000 * USA3='1'; /* TOP OF PAGE * 21290000 @94E L @1,OUT 0853 21300000 MVI 0(@1),C'1' 0853 21310000 * NUMO='00'X; /* ZERO COUNTER * 21320000 L @8,PARMPTR 0854 21330000 MVI 72(@8),X'00' 0854 21340000 * PGTITL='PAGE '; /* PAGE * 21350000 MVC 96(5,@1),@C34 0855 21360000 * PGNO=PG; /* PAGE NUMBER * 21370000 MVC 101(4,@1),PG 0856 21380000 * PGCNT=PGCNT+1; /* UPDATE PAGE NUMBER @ZA04919* 21390000 LA @F,1 0857 21400000 AH @F,PGCNT 0857 21410000 STH @F,PGCNT 0857 21420000 * PTR2=PGCNT; /* FOR CONV TO DEC @ZA04919* 21430000 LR @2,@F 0858 21440000 * GENERATE; /* CONVERT TO PRINT @ZA04919* 21450000 CVD PTR2,DBLW /* DECIMAL @ZA04919*/ 21460000 UNPK PG(4),DBLW+5(3) /* @ZA04919*/ 21470000 OI PG+3,X'F0' /* @ZA04919*/ 21480000 DS 0H 21490000 * RESTRICT (5,6); /* RESTRICT R5 AND R6 * 21500000 * BYPNT: R5=DCBOUT; /* ADDR OF OUTPUT DCB * 21510000 BYPNT L @1,PARMPTR 0861 21520000 L @5,4(0,@1) 0861 21530000 * R6=ADDR(PAGE); /* PRINT AREA ADDR * 21540000 L @4,OUT 0862 21550000 LR @6,@4 0862 21560000 * GENERATE (PUT (5),(6)); /* WRITE PAGE * 21570000 PUT (5),(6) 21580000 DS 0H 21590000 * R6=TITLEAD; /* TITLE ADDR * 21600000 L @1,PARMPTR 0864 21610000 L @6,8(0,@1) 0864 21620000 * GENERATE (PUT (5),(6)); /* WRITE TITLE * 21630000 PUT (5),(6) 21640000 DS 0H 21650000 * RELEASE (5,6); /* RELEASE RESTRICTION * 21660000 * RETURN; /* RETURN * 21670000 * END PRNT1; 21680000 @EL02 L @D,4(0,@D) 0868 21690000 LM @E,@C,12(@D) 0868 21700000 BCR 15,@E 0868 21710000 * /************************************************************ 21720000 * /* USER ID SORT AND PRINT ROUTINE * 21730000 * /************************************************************ 21740000 * IDSORT: PROCEDURE; 21750000 IDSORT STM @E,@C,12(@D) 0869 21760000 ST @D,@SAV003+4 0869 21770000 LA @F,@SAV003 0869 21780000 ST @F,8(0,@D) 0869 21790000 LR @D,@F 0869 21800000 * SRT=SORTOUT; /* START OF SORT TABLE * 21810000 MVC SRT(4),SORTOUT 0870 21820000 * IF SRT = SRTEND /* END OF TABLE * 21830000 * THEN /* YES * 21840000 L @F,SRTEND 0871 21850000 C @F,SRT 0871 21860000 * GO TO IDS2; /* WRITE HEADER * 21870000 BC 08,IDS2 0872 21880000 * ELSE; /* NULL ELSE * 21890000 * SRTPT=SRT; /* START OF TABLE * 21900000 MVC SRTPT(4),SRT 0874 21910000 * IDENTAB=IDENTDAT; /* MOVE FIRST ENTRY * 21920000 L @1,SRT 0875 21930000 MVC IDENTAB(51),0(@1) 0875 21940000 * IDS1: SRT=SRT+51; /* UP PTR TO SORT TABLE * 21950000 IDS1 LA @F,51 0876 21960000 A @F,SRT 0876 21970000 ST @F,SRT 0876 21980000 * IF USNAME ^< NAMUS /* ALPHA SORT CORRECT * 21990000 * THEN /* YES * 22000000 LR @1,@F 0877 22010000 CLC 0(8,@1),IDENTAB 0877 22020000 BC 04,@94D 0877 22030000 * DO; /* DO LOOP * 22040000 * IF SRT ^= SRTEND /* LAST ENTRY * 22050000 * THEN /* NO * 22060000 L @F,SRTEND 0879 22070000 C @F,SRT 0879 22080000 * GO TO IDS1; /* CONTINUE SORT * 22090000 BC 07,IDS1 0880 22100000 * ELSE /* YES * 22110000 * DO; /* DO LOOP * 22120000 * SRTPT=SRTPT+51; /* UP TABLE PTR * 22130000 LA @F,51 0882 22140000 A @F,SRTPT 0882 22150000 ST @F,SRTPT 0882 22160000 * GO TO IDS3; /* CONTINUE WITH NEXT ENTRY * 22170000 BC 15,IDS3 0883 22180000 * END; /* END OF DO LOOP * 22190000 * END; /* END OF DO LOOP * 22200000 * ELSE /* ALPHA ORDER INCORRECT * 22210000 * DO; /* YES * 22220000 * IDENSORT=IDENTDAT; /* SAVE PRESENT TABLE ENTRY * 22230000 @94D L @1,SRT 0887 22240000 MVC IDENSORT(51),0(@1) 0887 22250000 * IDENTDAT=IDENTAB; /* REPLACE WITH COMPARE ITEM * 22260000 MVC 0(51,@1),IDENTAB 0888 22270000 * SRT=SRTPT; /* REPLACE WITH NEEDED ADDRESS* 22280000 MVC SRT(4),SRTPT 0889 22290000 * IDENTDAT=IDENSORT; 22300000 L @1,SRT 0890 22310000 MVC 0(51,@1),IDENSORT 0890 22320000 * IDS3: SRT=SRTPT; /* USE NEW TABLE ENTRY * 22330000 IDS3 MVC SRT(4),SRTPT 0891 22340000 * IF SRTPT=SRTEND /* END OF TABLE * 22350000 * THEN /* YES * 22360000 L @F,SRTEND 0892 22370000 C @F,SRTPT 0892 22380000 * GO TO IDS2; /* BEGIN PRINTOUT * 22390000 BC 08,IDS2 0893 22400000 * ELSE /* NO * 22410000 * DO; /* DO LOOP * 22420000 * IDENTAB=IDENTDAT; /* COMPARE ITEM * 22430000 L @1,SRT 0895 22440000 MVC IDENTAB(51),0(@1) 0895 22450000 * GO TO IDS1; /* CONTINUE SORT * 22460000 BC 15,IDS1 0896 22470000 * END; /* END OF DO LOOP * 22480000 * END; /* END OF DO LOOP * 22490000 * IDS2: SRT=SORTOUT; /* START OF SORT TABLE Y03739 * 22500000 @94C EQU * 0899 22510000 IDS2 MVC SRT(4),SORTOUT 0899 22520000 * IF MDLB='1'B /* IS MODLIB SPECIFIED * 22530000 * THEN /* YES * 22540000 L @1,PARMPTR 0900 22550000 TM 20(@1),B'00001000' 0900 22560000 BC 12,@94B 0900 22570000 * DO; 22580000 * RSICH: IF RSIX='RSI' /* IS THIS NON USER DATA * 22590000 * THEN /* YES * 22600000 RSICH L @1,SRT 0902 22610000 CLC 11(3,@1),@C35 0902 22620000 BC 07,@94A 0902 22630000 * DO; 22640000 * RSICH1: SRT=SRT+51; /* BUMP PTR TO NEXT ENTRY * 22650000 RSICH1 LA @F,51 0904 22660000 A @F,SRT 0904 22670000 ST @F,SRT 0904 22680000 * IF SRT>SRTEND /* END OF TABLE * 22690000 * THEN /* YES * 22700000 L @F,SRTEND 0905 22710000 C @F,SRT 0905 22720000 * RETURN; /* RETURN TO CALLING ROUTINE * 22730000 BC 05,@EL03 0906 22740000 * ELSE; /* NULL ELSE * 22750000 * GO TO RSICH; /* CHECK NEXT ENTRY * 22760000 BC 15,RSICH 0908 22770000 * END; 22780000 * ELSE; /* NULL ELSE * 22790000 * END; 22800000 * ELSE; /* PRINT NEXT LINE * 22810000 @94B EQU * 0912 22820000 * IF NUMO > 48 /* LINE COUNT > 48? Y03739 * 22830000 * THEN /* YES Y03739 * 22840000 @946 L @1,PARMPTR 0913 22850000 CLI 72(@1),48 0913 22860000 BC 12,@945 0913 22870000 * CALL PRNT1; /* WRITE HEADER Y03739 * 22880000 BAL @E,PRNT1 0914 22890000 BC 15,@944 0915 22900000 * ELSE /* NO Y03739 * 22910000 * NUMO=NUMO+2; /* FOR LINE COUNT Y03739 * 22920000 @945 LA @F,2 0915 22930000 L @1,PARMPTR 0915 22940000 SR @0,@0 0915 22950000 IC @0,72(0,@1) 0915 22960000 AR @F,@0 0915 22970000 STC @F,72(0,@1) 0915 22980000 * IDS6: IDPRINT=BLANKS; /* BLANK OUT * 22990000 @944 EQU * 0916 23000000 IDS6 L @1,OUT 0916 23010000 MVC 0(1,@1),BLANKS 0916 23020000 MVI 1(@1),C' ' 0916 23030000 MVC 2(119,@1),1(@1) 0916 23040000 * USA5='0'; /* SKIP TWO LINES @ZA09119 * 23050000 MVI 0(@1),C'0' 0917 23060000 * USNAM='CSECT'; /* CSECT HEADING * 23070000 MVC 11(5,@1),@C16 0918 23080000 MVI 16(@1),C' ' 0918 23090000 MVC 17(2,@1),16(@1) 0918 23100000 * USYR='YR'; /* YR HEADING * 23110000 MVC 39(2,@1),@C17 0919 23120000 * USL='/'; /* / * 23130000 MVI 41(@1),C'/' 0920 23140000 * USDY='DAY'; /* DAY * 23150000 MVC 42(3,@1),@C19 0921 23160000 * USER='USER DATA'; /* USER DATA HEADING * 23170000 MVC 65(9,@1),@C36 0922 23180000 MVI 74(@1),C' ' 0922 23190000 MVC 75(30,@1),74(@1) 0922 23200000 * RESTRICT (5,6); /* RESTRICT R5 AND R6 * 23210000 * R5=DCBOUT; /* ADDRESS OF OUTPUT DCB * 23220000 L @4,PARMPTR 0924 23230000 L @5,4(0,@4) 0924 23240000 * R6=ADDR(IDPRINT); /* ADDR OF OUTPUT AREA * 23250000 LR @6,@1 0925 23260000 * GEN (PUT (5),(6)); /* PRINT OUTPUT LINE * 23270000 PUT (5),(6) 23280000 DS 0H 23290000 * GO TO IDS5; /* CONTINUE PRINTOUT * 23300000 BC 15,IDS5 0927 23310000 * IDS4: R5=DCBOUT; /* ADDR OF OUTPUT DCB * 23320000 IDS4 L @1,PARMPTR 0928 23330000 L @5,4(0,@1) 0928 23340000 * R6=ADDR(IDPRINT); /* OUTPUT AREA ADDR * 23350000 L @4,OUT 0929 23360000 LR @6,@4 0929 23370000 * GENERATE (PUT (5),(6)); 23380000 PUT (5),(6) 23390000 DS 0H 23400000 * USA5=' '; /* SINGLE SPACING * 23410000 MVI 0(@4),C' ' 0931 23420000 * NUMO=NUMO+1; /* FOR LINE COUNTER * 23430000 LA @F,1 0932 23440000 L @1,PARMPTR 0932 23450000 SR @0,@0 0932 23460000 IC @0,72(0,@1) 0932 23470000 AR @F,@0 0932 23480000 STC @F,72(0,@1) 0932 23490000 * LL=NUMO; /* LAST LINE * 23500000 MVC LL+1(1),72(@1) 0933 23510000 MVI LL,X'00' 0933 23520000 * IF NUMO > 50 /* LINE COUNT > 50? * 23530000 * THEN /* YES * 23540000 CLI 72(@1),50 0934 23550000 BC 12,@943 0934 23560000 * DO; /* DO LOOP * 23570000 * CALL PRNT1; /* PRINT NEW HEADER * 23580000 BAL @E,PRNT1 0936 23590000 * GO TO IDS6; /* PRINT NEW TITLE * 23600000 BC 15,IDS6 0937 23610000 * END; /* END OF DO LOOP * 23620000 * ELSE /* NO * 23630000 * GO TO IDS5; /* CONTINUE PRINTOUT * 23640000 * IDS5: IF SRT > SRTEND /* END OF TABLE * 23650000 * THEN /* YES * 23660000 @942 EQU * 0940 23670000 IDS5 L @F,SRTEND 0940 23680000 C @F,SRT 0940 23690000 BC 10,@941 0940 23700000 * DO; /* DO LOOP * 23710000 * PRNTDSH: IDPRINT(2)='-'; /* DASH @ZA09119 * 23720000 PRNTDSH L @1,OUT 0942 23730000 MVI 1(@1),C'-' 0942 23740000 * IDPRINT(3:121)=IDPRINT(2:120); /* PROPAGATE DASHES * 23750000 MVC 2(119,@1),1(@1) 0943 23760000 * USA5='0'; /* DOUBLE SPACING * 23770000 MVI 0(@1),C'0' 0944 23780000 * NUMO=NUMO+2; /* FOR LINE COUNT * 23790000 LA @F,2 0945 23800000 L @4,PARMPTR 0945 23810000 SR @0,@0 0945 23820000 IC @0,72(0,@4) 0945 23830000 AR @F,@0 0945 23840000 STC @F,72(0,@4) 0945 23850000 * GEN (PUT (5),(6)); 23860000 PUT (5),(6) 23870000 DS 0H 23880000 * RETURN; /* RETURN * 23890000 BC 15,@EL03 0947 23900000 * END; /* END OF DO LOOP * 23910000 * ELSE /* NO * 23920000 * DO; /* DO LOOP * 23930000 @941 EQU * 0949 23940000 * NONUSER: IF MDLB='1'B /* MODLIB SPECIFIED @ZA09119 * 23950000 * THEN /* YES * 23960000 NONUSER L @1,PARMPTR 0950 23970000 TM 20(@1),B'00001000' 0950 23980000 BC 12,@93F 0950 23990000 * DO; 24000000 * IF RSIX='RSI' /* IS THIS NON USER DATA * 24010000 * THEN 24020000 L @4,SRT 0952 24030000 CLC 11(3,@4),@C35 0952 24040000 BC 07,@93E 0952 24050000 * DO; 24060000 * SRT=SRT+51; /* BUMP PTR TO NEXT ENTRY * 24070000 LA @F,51 0954 24080000 A @F,SRT 0954 24090000 ST @F,SRT 0954 24100000 * IF SRT>SRTEND /* END OF TABLE * 24110000 * THEN /* YES * 24120000 L @F,SRTEND 0955 24130000 C @F,SRT 0955 24140000 * GO TO PRNTDSH; /* PRNT DASH @ZA09119 * 24150000 BC 04,PRNTDSH 0956 24160000 * ELSE; /* NULL ELSE * 24170000 * GO TO NONUSER; /* NON USER? @ZA09119 * 24180000 BC 15,NONUSER 0958 24190000 * END; 24200000 * ELSE; /* NULL ELSE * 24210000 * END; 24220000 * ELSE; /* NULL ELSE * 24230000 @93F EQU * 0962 24240000 * USNAM=USNAME; /* CSECT NAME * 24250000 @93C EQU * 0963 24260000 L @1,SRT 0963 24270000 L @4,OUT 0963 24280000 MVC 11(8,@4),0(@1) 0963 24290000 * USER=USSER; /* USER DATA * 24300000 MVC 65(40,@4),11(@1) 0964 24310000 * R5=ADDR(USDATE); /* ADDR OF PACKED DATE * 24320000 LA @5,8(0,@1) 0965 24330000 * R6=ADDR(UNPKAREA); /* ADDR OF UNPACK AREA * 24340000 LA @6,UNPKAREA 0966 24350000 * GENERATE (UNPK 0(5,6),0(3,5)); 24360000 UNPK 0(5,6),0(3,5) 24370000 DS 0H 24380000 * RELEASE (5,6); /* RELEASE RESTRICTION * 24390000 * USYR=YRZ; /* YEAR * 24400000 MVC 39(2,@4),UNPKAREA 0969 24410000 * USDY=DYZ; /* DAY * 24420000 MVC 42(3,@4),UNPKAREA+2 0970 24430000 * SRT=SRT+51; /* UP TABLE PTR * 24440000 LA @F,51 0971 24450000 A @F,SRT 0971 24460000 ST @F,SRT 0971 24470000 * GO TO IDS4; /* PRINT OUT NEXT ENTRY * 24480000 BC 15,IDS4 0972 24490000 * END; /* END OF DO LOOP * 24500000 * END IDSORT; 24510000 @940 EQU * 0974 24520000 @EL03 L @D,4(0,@D) 0974 24530000 LM @E,@C,12(@D) 0974 24540000 BCR 15,@E 0974 24550000 * /************************************************************ 24560000 * /* TRANSLATOR SORT AND PRINT ROUTINE * 24570000 * /************************************************************ 24580000 * TRSORT: PROCEDURE; 24590000 TRSORT STM @E,@C,12(@D) 0975 24600000 ST @D,@SAV004+4 0975 24610000 LA @F,@SAV004 0975 24620000 ST @F,8(0,@D) 0975 24630000 LR @D,@F 0975 24640000 * TRN=TRNOUT; /* START OF DATA TABLE * 24650000 MVC TRN(4),TRNOUT 0976 24660000 * TTRN=TRN; /* OLD ENTRY * 24670000 MVC TTRN(4),TRN 0977 24680000 * SRT=SORTOUT; /* START OF SORT TABLE * 24690000 MVC SRT(4),SORTOUT 0978 24700000 * SRTPT=SRT; /* OLD ENTRY ADDRESS * 24710000 MVC SRTPT(4),SRT 0979 24720000 * POINT=ADDR(TRS5); /* LINK ADDRESS * 24730000 LA @F,TRS5 0980 24740000 ST @F,POINT 0980 24750000 * IF NUMO > 48 /* LINE COUNT > 48? * 24760000 * THEN /* YES * 24770000 L @1,PARMPTR 0981 24780000 CLI 72(@1),48 0981 24790000 BC 12,@93B 0981 24800000 * CALL PRNT1; /* WRITE HEADER * 24810000 BAL @E,PRNT1 0982 24820000 BC 15,@93A 0983 24830000 * ELSE /* NO * 24840000 * NUMO=NUMO+2; /* FOR LINE COUNT * 24850000 @93B LA @F,2 0983 24860000 L @1,PARMPTR 0983 24870000 SR @0,@0 0983 24880000 IC @0,72(0,@1) 0983 24890000 AR @F,@0 0983 24900000 STC @F,72(0,@1) 0983 24910000 * TRS1: TRNPRNT=BLANKS; /* BLANK OUT PRINT AREA * 24920000 @93A EQU * 0984 24930000 TRS1 L @1,OUT 0984 24940000 MVC 0(1,@1),BLANKS 0984 24950000 MVI 1(@1),C' ' 0984 24960000 MVC 2(119,@1),1(@1) 0984 24970000 * USA7='0'; /* DOUBLE SPACING * 24980000 MVI 0(@1),C'0' 0985 24990000 * TRCSECT='CSECT'; /* CSECT * 25000000 MVC 11(5,@1),@C16 0986 25010000 MVI 16(@1),C' ' 0986 25020000 MVC 17(2,@1),16(@1) 0986 25030000 * TRNAME='TRANSLATOR'; /* TRANSLATOR * 25040000 MVC 24(10,@1),@C37 0987 25050000 * TRVR='VR'; /* VR * 25060000 MVC 49(2,@1),@C38 0988 25070000 * TRSL='.'; /* . * 25080000 MVI 51(@1),C'.' 0989 25090000 * TRMD='MD'; /* MD * 25100000 MVC 52(2,@1),@C39 0990 25110000 * TRYR='YR'; /* YR * 25120000 MVC 80(2,@1),@C17 0991 25130000 * TRSLSH='/'; /* / * 25140000 MVI 82(@1),C'/' 0992 25150000 * TRDY='DY'; /* DY * 25160000 MVC 83(2,@1),@C40 0993 25170000 MVI 85(@1),C' ' 0993 25180000 * RESTRICT (5,6); /* RESTRICT R5 AND R6 * 25190000 * R5=DCBOUT; /* ADDR OF OUTPUT DCB * 25200000 L @4,PARMPTR 0995 25210000 L @5,4(0,@4) 0995 25220000 * R6=ADDR(TRNPRNT); /* ADDR OF PRINT AREA * 25230000 LR @6,@1 0996 25240000 * GENERATE (PUT (5),(6)); 25250000 PUT (5),(6) 25260000 DS 0H 25270000 * GO TO TRS2; /* FOR NEXT TABLE ENTRY * 25280000 BC 15,TRS2 0998 25290000 * TRS4: IF SRT ^< SRTEND /* LAST ENTRY * 25300000 * THEN /* YES * 25310000 TRS4 L @F,SRTEND 0999 25320000 C @F,SRT 0999 25330000 BC 02,@939 0999 25340000 * DO; /* DO LOOP * 25350000 * TRNPRNT(2)='-'; /* DASH * 25360000 L @1,OUT 1001 25370000 MVI 1(@1),C'-' 1001 25380000 * TRNPRNT(3:121)=TRNPRNT(2:120); /* PROPAGATE DASHES * 25390000 MVC 2(119,@1),1(@1) 1002 25400000 * USA7='0'; /* DOUBLE SPACING * 25410000 MVI 0(@1),C'0' 1003 25420000 * NUMO=NUMO+2; /* FOR LINE COUNT * 25430000 LA @F,2 1004 25440000 L @4,PARMPTR 1004 25450000 SR @0,@0 1004 25460000 IC @0,72(0,@4) 1004 25470000 AR @F,@0 1004 25480000 STC @F,72(0,@4) 1004 25490000 * R5=DCBOUT; /* ADDR OF OUTPUT DCB * 25500000 L @5,4(0,@4) 1005 25510000 * R6=ADDR(TRNPRNT); /* ADDR OF OUTPUT LINE * 25520000 LR @6,@1 1006 25530000 * GEN(PUT (5),(6)); 25540000 PUT (5),(6) 25550000 DS 0H 25560000 * RETURN; /* RETURN * 25570000 BC 15,@EL04 1008 25580000 * END; /* END OF DO LOOP * 25590000 * ELSE /* NO * 25600000 * DO; /* DO LOOP * 25610000 * IF NUMO > 50 /* NEW PAGE? * 25620000 * THEN /* YES * 25630000 @939 L @1,PARMPTR 1011 25640000 CLI 72(@1),50 1011 25650000 BC 12,@937 1011 25660000 * DO; /* DO LOOP * 25670000 * CALL PRNT1; /* PRINT NEW HEADER * 25680000 BAL @E,PRNT1 1013 25690000 * GO TO TRS1; /* PRINT NEW TITLE * 25700000 BC 15,TRS1 1014 25710000 * END; /* END OF DO LOOP * 25720000 * ELSE /* NO * 25730000 * DO; /* DO LOOP * 25740000 * LL=NUMO; /* LASTLINE * 25750000 @937 L @1,PARMPTR 1017 25760000 MVC LL+1(1),72(@1) 1017 25770000 MVI LL,X'00' 1017 25780000 * NUMO=NUMO+1; /* ADD 1 TO COUNTER * 25790000 LA @F,1 1018 25800000 SR @0,@0 1018 25810000 IC @0,72(0,@1) 1018 25820000 AR @F,@0 1018 25830000 STC @F,72(0,@1) 1018 25840000 * GO TO TRS2; /* CONTINUE PROCESSING * 25850000 * END; /* END OF DO LOOP * 25860000 * END; /* END OF DO LOOP * 25870000 @936 EQU * 1021 25880000 * TRS2: TRCSECT=TNAME; /* CSECT NAME * 25890000 @938 EQU * 1022 25900000 TRS2 L @1,SRT 1022 25910000 L @4,OUT 1022 25920000 MVC 11(8,@4),0(@1) 1022 25930000 * TRNAME=TPROG; /* PROGRAM NAME * 25940000 L @7,TRN 1023 25950000 MVC 24(10,@4),0(@7) 1023 25960000 * R5=ADDR(TVER); /* PACKED DATA * 25970000 LA @5,10(0,@7) 1024 25980000 * R6=ADDR(UPAK2); /* UNPACK AREA * 25990000 LA @6,UPAK2 1025 26000000 * GENERATE (UNPK 0(5,6),0(3,5)); 26010000 UNPK 0(5,6),0(3,5) 26020000 DS 0H 26030000 * TRVR=UPK1; /* VERSION * 26040000 MVC 49(2,@4),UPAK2 1027 26050000 * TRMD=UPK2; /* MOD * 26060000 MVC 52(2,@4),UPAK2+2 1028 26070000 * R5=ADDR(TDATE); /* COMPILE DATE * 26080000 LA @5,12(0,@7) 1029 26090000 * R6=ADDR(UNPKAREA); /* UNPACK AREA ADDR * 26100000 LA @6,UNPKAREA 1030 26110000 * GENERATE (UNPK 0(5,6),0(3,5)); 26120000 UNPK 0(5,6),0(3,5) 26130000 DS 0H 26140000 * TRYR=YRZ; /* YEAR * 26150000 MVC 80(2,@4),UNPKAREA 1032 26160000 * TRDY=DYZ; /* DAY * 26170000 MVC 83(3,@4),UNPKAREA+2 1033 26180000 * TRS3: R5=DCBOUT; /* ADDRESS OF OUTPUT DCB * 26190000 TRS3 L @1,PARMPTR 1034 26200000 L @5,4(0,@1) 1034 26210000 * R6=ADDR(TRNPRNT); /* ADDR OF PRINT AREA * 26220000 L @4,OUT 1035 26230000 LR @6,@4 1035 26240000 * GENERATE (PUT (5),(6)); 26250000 PUT (5),(6) 26260000 DS 0H 26270000 * USA7=' '; /* SINGLE SPACING * 26280000 MVI 0(@4),C' ' 1037 26290000 * RELEASE (5,6); /* RELEASE RESTRICTION * 26300000 * GO TO LAB1; /* LINK ADDRESS * 26310000 L @1,POINT 1039 26320000 BCR 15,@1 1039 26330000 * TRS5: SRTPT=SRT; /* OLD ENTRY * 26340000 TRS5 MVC SRTPT(4),SRT 1040 26350000 * SRT=SRT+8; /* NEW ENTRY * 26360000 LA @F,8 1041 26370000 A @F,SRT 1041 26380000 ST @F,SRT 1041 26390000 * IF SRBYTE=BLANKS /* LAST CSECT FOR THIS TRANSL * 26400000 * THEN /* YES * 26410000 LR @1,@F 1042 26420000 CLC 0(1,@1),BLANKS 1042 26430000 BC 07,@935 1042 26440000 * DO; /* DO LOOP * 26450000 * TTRN=TRN; /* OLD ENTRY * 26460000 MVC TTRN(4),TRN 1044 26470000 * TRN=TRN+15; /* NEW ENTRY * 26480000 LA @F,15 1045 26490000 A @F,TRN 1045 26500000 ST @F,TRN 1045 26510000 * IF TRBYTE=BLANKS /* TWO TRANSLATORS * 26520000 * THEN /* NO * 26530000 LR @8,@F 1046 26540000 CLC 0(1,@8),BLANKS 1046 26550000 BC 07,@934 1046 26560000 * DO; /* DO LOOP * 26570000 * SRT=SRT+8; /* UP TRANS TABLE PTR * 26580000 LA @F,8 1048 26590000 A @F,SRT 1048 26600000 ST @F,SRT 1048 26610000 * TRN=TRN+15; /* UP DATA PTR * 26620000 LA @F,15 1049 26630000 A @F,TRN 1049 26640000 ST @F,TRN 1049 26650000 * POINT=ADDR(TRS5); /* LINK ADDRESS * 26660000 LA @F,TRS5 1050 26670000 ST @F,POINT 1050 26680000 * GO TO TRS4; /* BRANCH ADDRESS * 26690000 BC 15,TRS4 1051 26700000 * END; /* END OF DO LOOP * 26710000 * ELSE /* ANOTHER TRANSLATOR * 26720000 * DO; /* DO LOOP * 26730000 * POINT=ADDR(TRS6); /* LINK ADDRESS * 26740000 @934 LA @F,TRS6 1054 26750000 ST @F,POINT 1054 26760000 * NUMO=NUMO+1; /* ADD ONE TO COUNTER * 26770000 LA @F,1 1055 26780000 L @1,PARMPTR 1055 26790000 SR @0,@0 1055 26800000 IC @0,72(0,@1) 1055 26810000 AR @F,@0 1055 26820000 STC @F,72(0,@1) 1055 26830000 * GO TO TRS2; /* CONTINUE PROCESSING * 26840000 BC 15,TRS2 1056 26850000 * END; /* END OF DO LOOP * 26860000 * END; /* END OF DO LOOP * 26870000 * ELSE /* ANOTHER CSECT FOR THIS * 26880000 * /* TRANSLATOR * 26890000 * DO; /* DO LOOP * 26900000 * TTRN=TRN; /* OLD ENTRY * 26910000 @935 MVC TTRN(4),TRN 1060 26920000 * TRN=TRN+15; /* NEW ENTRY * 26930000 LA @F,15 1061 26940000 A @F,TRN 1061 26950000 ST @F,TRN 1061 26960000 * IF TRBYTE=BLANKS /* ONLY ONE TRANSLATOR * 26970000 * THEN /* YES * 26980000 LR @1,@F 1062 26990000 CLC 0(1,@1),BLANKS 1062 27000000 BC 07,@931 1062 27010000 * DO; /* DO LOOP * 27020000 * TRN=TTRN; /* OLD ENTRY * 27030000 MVC TRN(4),TTRN 1064 27040000 * POINT=ADDR(TRS5); /* LINK ADDRESS * 27050000 LA @F,TRS5 1065 27060000 ST @F,POINT 1065 27070000 * GO TO TRS4; /* NEXT TABLE ENTRY * 27080000 BC 15,TRS4 1066 27090000 * END; /* END OF DO LOOP * 27100000 * ELSE /* TWO TRANSLATORS * 27110000 * DO; /* DO LOOP * 27120000 * SRT=SRTPT; /* OLD ENTRY * 27130000 @931 MVC SRT(4),SRTPT 1069 27140000 * TNAME=BLANKS; /* BLANK OUT CSECT ENTRY * 27150000 L @1,SRT 1070 27160000 MVC 0(1,@1),BLANKS 1070 27170000 MVI 1(@1),C' ' 1070 27180000 MVC 2(6,@1),1(@1) 1070 27190000 * POINT=ADDR(TRS7); /* LINK ADDRESS * 27200000 LA @F,TRS7 1071 27210000 ST @F,POINT 1071 27220000 * NUMO=NUMO+1; /* ADD ONE TO COUNTER * 27230000 LA @F,1 1072 27240000 L @8,PARMPTR 1072 27250000 SR @0,@0 1072 27260000 IC @0,72(0,@8) 1072 27270000 AR @F,@0 1072 27280000 STC @F,72(0,@8) 1072 27290000 * GO TO TRS2; /* CONTINUE PROCESSING * 27300000 BC 15,TRS2 1073 27310000 * END; /* END OF DO LOOP * 27320000 * END; /* END OF DO LOOP * 27330000 @930 EQU * 1075 27340000 * TRS6: TTRN=TRN; /* OLD ENTRY * 27350000 @932 EQU * 1076 27360000 TRS6 MVC TTRN(4),TRN 1076 27370000 * TRN=TRN+15; /* NEW ENTRY * 27380000 LA @F,15 1077 27390000 A @F,TRN 1077 27400000 ST @F,TRN 1077 27410000 * SRT=SRT+8; /* UP TRANS TABLE PTR * 27420000 LA @F,8 1078 27430000 A @F,SRT 1078 27440000 ST @F,SRT 1078 27450000 * POINT=ADDR(TRS5); /* LINK ADDR * 27460000 LA @F,TRS5 1079 27470000 ST @F,POINT 1079 27480000 * GO TO TRS4; /* FOR NEXT TABLE ENTRY * 27490000 BC 15,TRS4 1080 27500000 * TRS7: SRT=SRT+8; /* NEXT TABLE ENTRY * 27510000 TRS7 LA @F,8 1081 27520000 A @F,SRT 1081 27530000 ST @F,SRT 1081 27540000 * IF SRBYTE=BLANKS /* NO MORE CSECTS * 27550000 * THEN /* YES - NO MORE CSECTS * 27560000 LR @1,@F 1082 27570000 CLC 0(1,@1),BLANKS 1082 27580000 BC 07,@92F 1082 27590000 * DO; /* DO LOOP * 27600000 * SRT=SRT+8; /* NEXT CSECT * 27610000 LA @F,8 1084 27620000 A @F,SRT 1084 27630000 ST @F,SRT 1084 27640000 * TRN=TRN+15; /* NEXT TRANSLATOR * 27650000 LA @F,15 1085 27660000 A @F,TRN 1085 27670000 ST @F,TRN 1085 27680000 * POINT=ADDR(TRS5); /* LINK ADDRESS * 27690000 LA @F,TRS5 1086 27700000 ST @F,POINT 1086 27710000 * GO TO TRS4; /* BRANCH ADDRESS * 27720000 BC 15,TRS4 1087 27730000 * END; /* END OF DO LOOP * 27740000 * ELSE /* MORE CSECTS * 27750000 * DO; /* DO LOOP * 27760000 * TRN=TTRN; /* OLD ENTRY * 27770000 @92F MVC TRN(4),TTRN 1090 27780000 * POINT=ADDR(TRS5); /* LINK ADDRESS * 27790000 LA @F,TRS5 1091 27800000 ST @F,POINT 1091 27810000 * GO TO TRS4; /* BRANCH ADDRESS * 27820000 BC 15,TRS4 1092 27830000 * END; /* END OF DO LOOP * 27840000 * END TRSORT; 27850000 @92E EQU * 1094 27860000 @EL04 L @D,4(0,@D) 1094 27870000 LM @E,@C,12(@D) 1094 27880000 BCR 15,@E 1094 27890000 * END HMBLKIDR; 27900000 @DATA1 EQU * 27910000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 27920000 @1 EQU 01 27930000 @2 EQU 02 27940000 @3 EQU 03 27950000 @4 EQU 04 27960000 @5 EQU 05 27970000 @6 EQU 06 27980000 @7 EQU 07 27990000 @8 EQU 08 28000000 @9 EQU 09 28010000 @A EQU 10 28020000 @B EQU 11 28030000 @C EQU 12 28040000 @D EQU 13 28050000 @E EQU 14 28060000 @F EQU 15 28070000 @D1 DC H'16' 28080000 @D2 DC H'-2' 28090000 @D3 DC H'15' 28100000 @D4 DC H'3' 28110000 @D5 DC H'2' 28120000 @D6 DC H'1' 28130000 @D7 DC H'4' 28140000 @D8 DC H'6' 28150000 DS 0F 28160000 @SIZ001 DC AL1(&SPN) 28170000 DC AL3(@DATEND-@DATD) 28180000 DS 0F 28190000 @C4 DC C'0001' 28200000 @C12 DC C'$PRIVATE' 28210000 @C20 DC C'IMASPZAP' 28220000 @C25 DC C'THIS LOAD MODULE WAS PRODUCED BY LINKAGE EDITOR ' 28230000 @C28 DC C' ON DAY ' 28240000 @C17 DC C'YR' 28250000 @C23 DC C'THIS LOAD MODULE CONTAINS ' 28260000 @C26 DC C' AT LEVEL ' 28270000 @C37 DC C'TRANSLATOR' 28280000 @C38 DC C'VR' 28290000 @C39 DC C'MD' 28300000 @C40 DC C'DY' 28310000 @C16 DC C'CSECT' 28320000 @C19 DC C'DAY' 28330000 @C21 DC C' DATA' 28340000 @C24 DC C'NO INFORMATION SUPPLIED BY IMASPZAP' 28350000 @C29 DC C' OF YEAR ' 28360000 @C30 DC C'MISSING' 28370000 @C31 DC C'LISTIDR' 28380000 @C32 DC C' FOR LOAD MODULE ' 28390000 @C34 DC C'PAGE ' 28400000 @C35 DC C'RSI' 28410000 @C36 DC C'USER DATA' 28420000 DS 0D 28430000 @DATA EQU * 28440000 DUMMY EQU 00000000 FULLWORD INTEGER 28450000 REG1 EQU 00000001 FULLWORD POINTER REGISTER 28460000 PTR2 EQU 00000002 FULLWORD INTEGER REGISTER 28470000 R5 EQU 00000005 FULLWORD POINTER REGISTER 28480000 R6 EQU 00000006 FULLWORD POINTER REGISTER 28490000 SRBYTE EQU 00000000 1 BYTE(S) 28500000 TRBYTE EQU 00000000 1 BYTE(S) 28510000 PAGE EQU 00000000 121 BYTE(S) ON WORD 28520000 USA3 EQU PAGE+00000000 1 BYTE(S) 28530000 NULL EQU PAGE+00000001 43 BYTE(S) 28540000 TITLE EQU PAGE+00000044 7 BYTE(S) 28550000 TIT2 EQU PAGE+00000051 17 BYTE(S) 28560000 MEM EQU PAGE+00000068 8 BYTE(S) 28570000 NULL2 EQU PAGE+00000076 20 BYTE(S) 28580000 PGTITL EQU PAGE+00000096 5 BYTE(S) 28590000 PGNO EQU PAGE+00000101 4 BYTE(S) 28600000 NONE EQU PAGE+00000105 16 BYTE(S) 28610000 CESDRC EQU 00000000 8 BYTE(S) ON WORD 28620000 TYPE EQU CESDRC+00000000 8 BIT(S) 28630000 SPARE EQU CESDRC+00000001 3 BYTE(S) 28640000 ESDID EQU CESDRC+00000004 2 BYTE(S) 28650000 COUNT EQU CESDRC+00000006 2 BYTE(S) 28660000 IDRREC EQU 00000000 3 BYTE(S) ON WORD 28670000 ID EQU IDRREC+00000000 8 BIT(S) 28680000 BYTCNT EQU IDRREC+00000001 1 BYTE(S) 28690000 SUBTYP EQU IDRREC+00000002 8 BIT(S) 28700000 LINKRC EQU 00000000 18 BYTE(S) ON WORD 28710000 SPARE3 EQU LINKRC+00000000 3 BYTE(S) 28720000 PROGNM EQU LINKRC+00000003 10 BYTE(S) 28730000 VRSION EQU LINKRC+00000013 2 BYTE(S) 28740000 LKDATE EQU LINKRC+00000015 3 BYTE(S) 28750000 TRANS EQU 00000000 2 BYTE(S) ON WORD 28760000 ESDBITS EQU TRANS+00000000 16 BIT(S) 28770000 USRDATA EQU 00000000 6 BYTE(S) ON WORD 28780000 ESD4 EQU USRDATA+00000000 2 BYTE(S) 28790000 DATE5 EQU USRDATA+00000002 3 BYTE(S) 28800000 CNT EQU USRDATA+00000005 1 BYTE POINTER 28810000 CESDATA EQU 00000000 16 BYTE(S) ON WORD 28820000 EXTRNAM EQU CESDATA+00000000 8 BYTE(S) 28830000 ESDTYP EQU CESDATA+00000008 8 BIT(S) 28840000 SKIP EQU CESDATA+00000009 7 BYTE(S) 28850000 ZAPD EQU 00000000 1 BYTE(S) ON WORD 28860000 FLG EQU ZAPD+00000000 8 BIT(S) 28870000 ZAP EQU 00000000 13 BYTE(S) ON WORD 28880000 ESD EQU ZAP+00000000 2 BYTE(S) 28890000 DATE1 EQU ZAP+00000002 3 BYTE(S) 28900000 ZP EQU ZAP+00000005 8 BYTE(S) 28910000 TRNSDSC EQU 00000000 15 BYTE(S) ON WORD 28920000 PGM EQU TRNSDSC+00000000 10 BYTE(S) 28930000 VRMOD EQU TRNSDSC+00000010 2 BYTE(S) 28940000 CMPLE EQU TRNSDSC+00000012 3 BYTE(S) 28950000 TRNTAB EQU 00000000 8 BYTE(S) ON WORD 28960000 TNAME EQU TRNTAB+00000000 8 BYTE(S) 28970000 TDTAB EQU 00000000 15 BYTE(S) ON WORD 28980000 TPROG EQU TDTAB+00000000 10 BYTE(S) 28990000 TVER EQU TDTAB+00000010 2 BYTE(S) 29000000 TDATE EQU TDTAB+00000012 3 BYTE(S) 29010000 TRNPRNT EQU 00000000 121 BYTE(S) ON WORD 29020000 USA7 EQU TRNPRNT+00000000 1 BYTE(S) 29030000 SSA EQU TRNPRNT+00000001 10 BYTE(S) 29040000 TRCSECT EQU TRNPRNT+00000011 8 BYTE(S) 29050000 SSB EQU TRNPRNT+00000019 5 BYTE(S) 29060000 TRNAME EQU TRNPRNT+00000024 10 BYTE(S) 29070000 SSC EQU TRNPRNT+00000034 15 BYTE(S) 29080000 TRVR EQU TRNPRNT+00000049 2 BYTE(S) 29090000 TRSL EQU TRNPRNT+00000051 1 BYTE(S) 29100000 TRMD EQU TRNPRNT+00000052 2 BYTE(S) 29110000 SSD EQU TRNPRNT+00000054 26 BYTE(S) 29120000 TRYR EQU TRNPRNT+00000080 2 BYTE(S) 29130000 TRSLSH EQU TRNPRNT+00000082 1 BYTE(S) 29140000 TRDY EQU TRNPRNT+00000083 3 BYTE(S) 29150000 SSE EQU TRNPRNT+00000086 35 BYTE(S) 29160000 LINKOUT EQU 00000000 121 BYTE(S) ON WORD 29170000 USA4 EQU LINKOUT+00000000 1 BYTE(S) 29180000 SP12 EQU LINKOUT+00000001 9 BYTE(S) 29190000 MSG1 EQU LINKOUT+00000010 48 BYTE(S) 29200000 MSG2 EQU LINKOUT+00000058 10 BYTE(S) 29210000 SP10 EQU LINKOUT+00000068 10 BYTE(S) 29220000 MSG3A EQU LINKOUT+00000078 2 BYTE(S) 29230000 MSG3B EQU LINKOUT+00000080 1 BYTE(S) 29240000 MSG3C EQU LINKOUT+00000081 2 BYTE(S) 29250000 SP8 EQU LINKOUT+00000083 8 BYTE(S) 29260000 MSG4 EQU LINKOUT+00000091 3 BYTE(S) 29270000 SP9 EQU LINKOUT+00000094 9 BYTE(S) 29280000 MSG5 EQU LINKOUT+00000103 2 BYTE(S) 29290000 DOT EQU LINKOUT+00000105 1 BYTE(S) 29300000 SP11 EQU LINKOUT+00000106 15 BYTE(S) 29310000 SPBYT EQU 00000000 8 BIT(S) ON BYTE 29320000 SPBIT EQU 00000000 1 BYTE POINTER 29330000 CSDTAB EQU 00000000 12 BYTE(S) ON WORD 29340000 NAME EQU CSDTAB+00000000 8 BYTE(S) 29350000 SPARE6 EQU CSDTAB+00000008 2 BYTE(S) 29360000 IDEN EQU CSDTAB+00000010 2 BYTE(S) 29370000 SORTAB EQU 00000000 19 BYTE(S) ON WORD 29380000 CNAME EQU SORTAB+00000000 8 BYTE(S) 29390000 ZPDATE EQU SORTAB+00000008 3 BYTE(S) 29400000 DAZP EQU SORTAB+00000011 8 BYTE(S) 29410000 ZPPRINT EQU 00000000 121 BYTE(S) ON WORD 29420000 USA2 EQU ZPPRINT+00000000 1 BYTE(S) 29430000 SPCA EQU ZPPRINT+00000001 20 BYTE(S) 29440000 CSNAME EQU ZPPRINT+00000021 8 BYTE(S) 29450000 SPCB EQU ZPPRINT+00000029 20 BYTE(S) 29460000 YEAR EQU ZPPRINT+00000049 2 BYTE(S) 29470000 SL EQU ZPPRINT+00000051 1 BYTE(S) 29480000 DATE EQU ZPPRINT+00000052 3 BYTE(S) 29490000 SPCC EQU ZPPRINT+00000055 20 BYTE(S) 29500000 ZPD EQU ZPPRINT+00000075 8 BYTE(S) 29510000 SPCD EQU ZPPRINT+00000083 38 BYTE(S) 29520000 NOZAP EQU 00000000 121 BYTE(S) ON WORD 29530000 USA6 EQU NOZAP+00000000 1 BYTE(S) 29540000 SPEA EQU NOZAP+00000001 25 BYTE(S) 29550000 ZPMSG1 EQU NOZAP+00000026 26 BYTE(S) 29560000 ZPMSG2 EQU NOZAP+00000052 35 BYTE(S) 29570000 SPEB EQU NOZAP+00000087 34 BYTE(S) 29580000 IDENTDAT EQU 00000000 51 BYTE(S) ON WORD 29590000 USNAME EQU IDENTDAT+00000000 8 BYTE(S) 29600000 USDATE EQU IDENTDAT+00000008 3 BYTE(S) 29610000 USSER EQU IDENTDAT+00000011 40 BYTE(S) 29620000 RSIX EQU IDENTDAT+00000011 3 BYTE(S) 29630000 A00000 EQU IDENTDAT+00000014 37 BYTE(S) 29640000 IDPRINT EQU 00000000 121 BYTE(S) ON WORD 29650000 USA5 EQU IDPRINT+00000000 1 BYTE(S) 29660000 SPDA EQU IDPRINT+00000001 10 BYTE(S) 29670000 USNAM EQU IDPRINT+00000011 8 BYTE(S) 29680000 SPDB EQU IDPRINT+00000019 20 BYTE(S) 29690000 USYR EQU IDPRINT+00000039 2 BYTE(S) 29700000 USL EQU IDPRINT+00000041 1 BYTE(S) 29710000 USDY EQU IDPRINT+00000042 3 BYTE(S) 29720000 SPDC EQU IDPRINT+00000045 20 BYTE(S) 29730000 USER EQU IDPRINT+00000065 40 BYTE(S) 29740000 SPDD EQU IDPRINT+00000105 16 BYTE(S) 29750000 USINFO EQU 00000000 1 BYTE POINTER 29760000 INFO EQU 00000000 1 BYTE POINTER 29770000 MAINT EQU * 400 BYTE(S) ON DWORD 29780000 DC C'MAINTENANCE' 29790000 DC 00389C' ' 29800000 PARMLIST EQU 00000000 73 BYTE(S) ON WORD 29810000 DCBIN EQU PARMLIST+00000000 FULLWORD POINTER 29820000 DCBOUT EQU PARMLIST+00000004 FULLWORD POINTER 29830000 TITLEAD EQU PARMLIST+00000008 FULLWORD POINTER 29840000 AREAGET EQU PARMLIST+00000012 FULLWORD POINTER 29850000 GMLENGTH EQU PARMLIST+00000016 FULLWORD INTEGER 29860000 FLAGS EQU PARMLIST+00000020 16 BIT(S) 29870000 IDRFLAG EQU PARMLIST+00000020 1 BIT(S) 29880000 OVLYFLAG EQU PARMLIST+00000020 1 BIT(S) 29890000 NOTEDIT EQU PARMLIST+00000020 1 BIT(S) 29900000 NORLD EQU PARMLIST+00000020 1 BIT(S) 29910000 MDLB EQU PARMLIST+00000020 1 BIT(S) 29920000 A00001 EQU PARMLIST+00000020 11 BIT(S) 29930000 BLKCNT EQU PARMLIST+00000022 HALFWORD INTEGER 29940000 BUFF EQU PARMLIST+00000024 FULLWORD POINTER 29950000 SCATLEN EQU PARMLIST+00000028 FULLWORD INTEGER 29960000 ERRORS EQU PARMLIST+00000032 32 BIT(S) 29970000 MEMNAME EQU PARMLIST+00000036 8 BYTE(S) 29980000 DDNAME EQU PARMLIST+00000044 8 BYTE(S) 29990000 TXTTR EQU PARMLIST+00000052 3 BYTE(S) 30000000 TXTLEN EQU PARMLIST+00000055 2 BYTE(S) 30010000 A00002 EQU PARMLIST+00000060 FULLWORD INTEGER 30020000 A00003 EQU PARMLIST+00000064 4 BYTE(S) 30030000 A00004 EQU PARMLIST+00000068 4 BYTE(S) 30040000 NUMO EQU PARMLIST+00000072 1 BYTE POINTER 30050000 ORG @DATA 30060000 DS 00000400C 30070000 @L EQU 1 30080000 @DATD DSECT 30090000 @SAV001 EQU @DATD+00000000 72 BYTE(S) ON WORD 30100000 PARMPTR EQU @DATD+00000072 FULLWORD POINTER 30110000 CSDEND EQU @DATD+00000076 FULLWORD POINTER 30120000 A EQU @DATD+00000080 1 BYTE POINTER 30130000 INREC EQU @DATD+00000084 FULLWORD POINTER 30140000 NEXT EQU @DATD+00000088 FULLWORD POINTER 30150000 CSDNXT EQU @DATD+00000092 FULLWORD POINTER 30160000 SRT EQU @DATD+00000096 FULLWORD POINTER 30170000 SRTEND EQU @DATD+00000100 FULLWORD POINTER 30180000 TRNOUT EQU @DATD+00000104 FULLWORD INTEGER 30190000 OUT EQU @DATD+00000108 FULLWORD POINTER 30200000 CSDPT EQU @DATD+00000112 FULLWORD INTEGER 30210000 SORTOUT EQU @DATD+00000116 FULLWORD INTEGER 30220000 SRTPT EQU @DATD+00000120 FULLWORD INTEGER 30230000 TRN EQU @DATD+00000124 FULLWORD POINTER 30240000 TTRN EQU @DATD+00000128 FULLWORD INTEGER 30250000 COUNTER EQU @DATD+00000132 1 BYTE POINTER 30260000 NUMBS EQU @DATD+00000133 1 BYTE POINTER 30270000 SWITCH EQU @DATD+00000134 8 BIT(S) ON BYTE 30280000 ESDNO EQU @DATD+00000136 HALFWORD INTEGER 30290000 ESDCOUNT EQU @DATD+00000138 HALFWORD INTEGER 30300000 BLANKS EQU @DATD+00000140 1 BYTE(S) 30310000 LL EQU @DATD+00000142 HALFWORD INTEGER 30320000 READLIST EQU @DATD+00000144 30 BYTE(S) ON WORD 30330000 BYTES EQU @DATD+00000174 1 BYTE POINTER 30340000 FLG1 EQU @DATD+00000175 8 BIT(S) ON BYTE 30350000 PG EQU @DATD+00000176 FULLWORD INTEGER 30360000 PGCNT EQU @DATD+00000180 HALFWORD INTEGER 30370000 DBLW EQU @DATD+00000184 9 BYTE(S) ON DWORD 30380000 WRD1 EQU DBLW+00000000 FULLWORD INTEGER 30390000 HWRD1 EQU DBLW+00000000 2 BYTE(S) 30400000 SIXBYT EQU DBLW+00000002 6 BYTE(S) 30410000 HWRD2 EQU DBLW+00000002 2 BYTE(S) 30420000 WRD2 EQU DBLW+00000004 FULLWORD INTEGER 30430000 BYTE2 EQU DBLW+00000004 2 BYTE(S) 30440000 BYTE2A EQU DBLW+00000006 2 BYTE(S) 30450000 DUMY EQU DBLW+00000008 1 BYTE(S) 30460000 TBIT EQU @DATD+00000193 8 BIT(S) ON BYTE 30470000 TYP EQU @DATD+00000194 1 BIT(S) ON BYTE 30480000 SW1 EQU @DATD+00000195 2 BIT(S) ON BYTE 30490000 POINT EQU @DATD+00000196 FULLWORD POINTER 30500000 ZAPSORT EQU @DATD+00000200 19 BYTE(S) 30510000 SORTAREA EQU @DATD+00000220 19 BYTE(S) ON WORD 30520000 CSECTNM EQU SORTAREA+00000000 8 BYTE(S) 30530000 ZPSPACE EQU SORTAREA+00000008 11 BYTE(S) 30540000 UPAK2 EQU @DATD+00000240 5 BYTE(S) ON WORD 30550000 UPK1 EQU UPAK2+00000000 2 BYTE(S) 30560000 UPK2 EQU UPAK2+00000002 2 BYTE(S) 30570000 GARB EQU UPAK2+00000004 1 BYTE(S) 30580000 UNPKAREA EQU @DATD+00000248 5 BYTE(S) ON WORD 30590000 YRZ EQU UNPKAREA+00000000 2 BYTE(S) 30600000 DYZ EQU UNPKAREA+00000002 3 BYTE(S) 30610000 IDENTAB EQU @DATD+00000256 51 BYTE(S) ON WORD 30620000 NAMUS EQU IDENTAB+00000000 8 BYTE(S) 30630000 RESTAB EQU IDENTAB+00000008 43 BYTE(S) 30640000 IDENSORT EQU @DATD+00000307 51 BYTE(S) 30650000 IDSAVE EQU @DATD+00000358 16 BIT(S) ON BYTE 30660000 SAV1 EQU IDSAVE+00000000 8 BIT(S) 30670000 SAV2 EQU IDSAVE+00000001 8 BIT(S) 30680000 NOTETTR EQU @DATD+00000360 4 BYTE(S) ON WORD 30690000 @SAV002 EQU @DATD+00000368 72 BYTE(S) ON WORD 30700000 @SAV003 EQU @DATD+00000440 72 BYTE(S) ON WORD 30710000 @SAV004 EQU @DATD+00000512 72 BYTE(S) ON WORD 30720000 DS 00000596C 30730000 @TEMPS DS 0F 30740000 DS C 30750000 HMBLKIDR CSECT 30760000 RDLIST READ RDECB,SF,MF=L 30770000 RDLGTH EQU *-RDLIST 30780000 @DATD DSECT 30790000 @DATEND EQU * 30800000 HMBLKIDR CSECT , 30810000 @9F0 EQU LK 30820000 @9EF EQU LK 30830000 @9EC EQU READRT 30840000 @9EB EQU @9EA 30850000 @9E5 EQU READRT 30860000 @9E6 EQU LKERT 30870000 @9E3 EQU @9E2 30880000 @9D4 EQU IDR2 30890000 @9D5 EQU IDR2 30900000 @9CA EQU @9C9 30910000 @9B1 EQU ERR1 30920000 @9AD EQU @9AA 30930000 @9A3 EQU WRZAP 30940000 @995 EQU @990 30950000 @98F EQU ERR1 30960000 @98B EQU @98A 30970000 @97D EQU READRT 30980000 @976 EQU TR2 30990000 @975 EQU @974 31000000 @971 EQU @970 31010000 @973 EQU TR1 31020000 @96B EQU @96A 31030000 @966 EQU TR4 31040000 @967 EQU @964 31050000 @965 EQU @964 31060000 @95F EQU READRT 31070000 BYMSG EQU @EL01 31080000 @958 EQU NONAME 31090000 @956 EQU NONAME 31100000 @953 EQU ERR1 31110000 @948 EQU RSICH 31120000 @949 EQU RSICH 31130000 @947 EQU @946 31140000 @94A EQU @946 31150000 @943 EQU IDS5 31160000 @93D EQU @93C 31170000 @93E EQU @93C 31180000 @933 EQU @932 31190000 @9E4 EQU @9E3 31200000 @96C EQU @96B 31210000 END HMBLKIDR,(C'PL/S',1400,76175) 31220000