Columbia Kermit

home *** CD-ROM | disk | FTP | other *** search

/ Columbia Kermit / kermit.zip / cicsussr / ecker-utf8.asm < prev next >

Wrap

Assembly Source File | 2020-01-01 | 275KB | 3,297 lines

* IF YOU DON'T SEE RUSSIAN TEXT SET YOUR BROWSER'S ENCODING TO UTF-8 * PRINT ON,GEN 00010001 *********************************************************************** 00020000 * * * C O U R I E R - C I C S (KAMA) * * * 00030006 *********************************************************************** 00040000 * ╨ƒPO╨ôPAMMA COURIER - CICS PEA╨¢╨ÿ╨ù╨úET ╨ƒPOTOKO╨¢ ╨ƒEPE╨öA╨º╨ÿ ╨ñA╨Ö╨¢OB * 00050006 * KERMIT. COURIER - CICS PA╨æOTAET C ╨ƒCEB╨öOTEPM╨ÿHA╨¢OM EC-8570. * 00060006 * PEA╨¢╨ÿ╨ùOBAH TO╨¢╨¼KO ╨ú╨öA╨¢EHH╨½╨Ö BAP╨ÿAHT. H╨ÿ╨ûE ╨ƒP╨ÿBE╨öEH╨½ BO╨ùMO╨ûHOCT╨ÿ,* 00070000 * PEA╨¢╨ÿ╨ùOBAHH╨½E B BEPC╨ÿ╨ÿ 2.20 ╨ƒPO╨ôPAMM╨½ COURIER - CICS. * 00080006 * * 00090000 * - ╨¢OKA╨¢╨¼H╨½╨Ö BAP╨ÿAHT PA╨æOT╨½. * 00100000 * + ╨ú╨öA╨¢EHH╨½╨Ö BAP╨ÿAHT. * 00110000 * + ╨ƒEPE╨öA╨ºA TEKCTOB╨½X ╨ñA╨Ö╨¢OB. * 00120000 * + ╨ƒEPE╨öA╨ºA ╨öBO╨ÿ╨ºH╨½X ╨ñA╨Ö╨¢OB. * 00130000 * - ╨ôP╨ú╨ƒ╨ƒOBA╨» ╨ƒEPE╨öA╨ºA ╨ñA╨Ö╨¢OB. * 00140000 * - TA╨ÖMA╨úT. * 00150000 * + ╨ƒPE╨ñ╨ÿKCA╨ª╨ÿ╨» CTAP╨¿E╨ôO ╨æ╨ÿTA. * 00160000 * - C╨ûAT╨ÿE ╨ƒOBTOP╨»╨«╨⌐E╨ÖC╨» ╨ÿH╨ñOPMA╨ª╨ÿ╨ÿ. * 00170000 * - A╨¢╨¼TEPHAT╨ÿBH╨½E KOHTPO╨¢╨¼H╨½E C╨úMM╨½. * 00180000 * + A╨¢╨¼TEPHAT╨ÿBH╨½E TA╨æ╨¢╨ÿ╨ª╨½ ╨ƒEPEKO╨ö╨ÿPOBK╨ÿ. * 00190000 * - ╨ƒPEP╨½BAH╨ÿE ╨ƒEPE╨öA╨º╨ÿ. * 00200004 * - PA╨æOTA B PE╨û╨ÿME CEPBEPA. * 00210000 * - ╨ú╨ƒPAB╨¢EH╨ÿE ╨¢OKA╨¢╨¼H╨½M╨ÿ ╨ñA╨Ö╨¢AM╨ÿ. * 00220000 * - O╨æPA╨æOTKA ATP╨ÿ╨æ╨úTOB ╨ñA╨Ö╨¢OB. * 00230000 * - MAKPOKOMAH╨ö╨½. * 00240000 * - KOMAH╨öH╨½E ╨ñA╨Ö╨¢╨½. * 00250000 * * 00260000 * COURIER - CICS (BEPC╨ÿ╨» 2.20) * 00270001 * PA╨ùPA╨æOTAH B ME╨û╨ö╨úHAPO╨öHOM ╨ªEHTPE HA╨ú╨ºHO╨Ö ╨ÿ TEXH╨ÿ╨ºECKO╨Ö * 00280000 * ╨ÿH╨ñOPMA╨ª╨ÿ╨ÿ. * 00290000 * * 00300000 * MOCKBA, 1988 ╨ôO╨ö. * 00310000 *********************************************************************** 00320000 TITLE 'COURIER - CICS' 00330000 *********************************************************************** 00340000 MACRO 00350000 &N WRMESS &TEXT 00360000 LCLA &NUM 00370000 &NUM SETA K'&TEXT 00380000 &NUM SETA &NUM-2 00390000 &N MVI PACKAGE,&NUM 00400000 MVC PACKAGE+1(&NUM),=C&TEXT 00410000 L 14,=A(WRITMS) 00420000 BALR 15,14 00430000 MEND 00440000 *********************************************************************** 00450000 MACRO 00460000 &N WRTEXT &ADR,&LN 00470000 &N MVI PACKAGE,&LN 00480000 MVC PACKAGE+1(&LN),&ADR 00490000 L 14,=A(WRITMS) 00500000 BALR 15,14 00510000 MEND 00520000 *********************************************************************** 00530000 MACRO 00540000 &N BINCVRT ®,&AREA,&DBLWRK 00550000 &N CVD ®,&DBLWRK 00560000 MVC &AREA.(6),=X'402020202120' 00570000 ED &AREA.(6),&DBLWRK+5 00580000 MEND 00590000 *********************************************************************** 00600000 MACRO 00610000 &LABEL CALL &PROG 00620000 &LABEL L 14,=A(&PROG) 00630000 BALR 15,14 00640000 MEND 00650000 *********************************************************************** 00660000 MACRO 00670000 &LABEL SAVE 00680000 DS 0H 00690000 &LABEL ST 15,$ADDR$SV+4 00700000 L 15,$ADDR$SV 00710000 LA 15,36(15) 9 PE╨ô╨ÿCTPOB (9 * 4 = 36) 00720000 ST 15,$ADDR$SV 00730000 ST BASE,0(15) 00740000 STM 0,6,8(15) 00750000 MVC 4(4,15),$ADDR$SV+4 00760000 MEND 00770000 *********************************************************************** 00780000 MACRO 00790000 &LABEL RETURN 00800000 &LABEL L 15,$ADDR$SV 00810000 LM 0,6,8(15) 00820000 MVC $ADDR$SV(8),0(15) 00830000 SH 15,=H'36' 9 PE╨ô╨ÿCTPOB 00840000 L BASE,$ADDR$SV 00850000 ST 15,$ADDR$SV 00860000 L 15,$ADDR$SV+4 00870000 BR 15 00880000 MEND 00890000 *********************************************************************** 00900000 MACRO 00910000 &NAME BRTORC &RC0,&RC2,&RC4,&RC6,&RC8,&RC10,&RC12,&REST= 00920000 AIF (N'&SYSLIST NE 0).L010 00930000 .L000 MNOTE 8,'HEBEPHA╨» ╨ùA╨ƒ╨ÿC╨¼ MAKPOKOMAH╨ö╨½' 00940000 MEXIT 00950000 .L010 AIF (K'&REST EQ 0).L000 00960000 AIF (N'&SYSLIST NE 1).L020 00970000 LTR 14,14 00980000 BNZ &REST 00990000 B &RC0 01000000 MEXIT 01010000 .L020 AIF (N'&SYSLIST NE 2).L030 01020000 CH 14,=H'2' 01030000 AGO .L100 01040000 .L030 AIF (N'&SYSLIST NE 3).L040 01050000 CH 14,=H'4' 01060000 AGO .L100 01070000 .L040 AIF (N'&SYSLIST NE 4).L050 01080000 CH 14,=H'6' 01090000 AGO .L100 01100000 .L050 AIF (N'&SYSLIST NE 5).L060 01110000 CH 14,=H'8' 01120000 AGO .L100 01130000 .L060 AIF (N'&SYSLIST NE 6).L070 01140000 CH 14,=H'10' 01150000 AGO .L100 01160000 .L070 AIF (N'&SYSLIST NE 7).L000 01170000 CH 14,=H'12' 01180000 .L100 BH &REST 01190000 SLL R14,1 ╨úMHO╨û╨ÿM HA 2 01200000 LA 15,BR&SYSNDX 01210000 AR 15,14 01220000 BR 15 01230000 BR&SYSNDX B &RC0 01240000 B &RC2 01250000 AIF (N'&SYSLIST EQ 2).L200 01260000 B &RC4 01270000 AIF (N'&SYSLIST EQ 3).L200 01280000 B &RC6 01290000 AIF (N'&SYSLIST EQ 4).L200 01300000 B &RC8 01310000 AIF (N'&SYSLIST EQ 5).L200 01320000 B &RC10 01330000 AIF (N'&SYSLIST EQ 6).L200 01340000 B &RC12 01350000 .L200 MEXIT 01360000 MEND 01370000 *********************************************************************** 01380000 *====================================================================== 01390000 PRINT ON,NOGEN 01400000 *====================================================================== 01410000 * KO╨ö╨½ BO╨ùBPATA 01420000 E$OK EQU X'00' O╨¿╨ÿ╨æOK HET 01430000 E$CHECK EQU X'01' O╨¿╨ÿ╨æKA B KOHTPO╨¢╨¼HO╨Ö C╨úMME 01440000 E$LENG EQU X'02' HEBEPHA╨» ╨ö╨¢╨ÿHA ╨ƒAKETA 01450000 E$LENA EQU X'02' HEBEPH╨½╨Ö ATP╨ÿ╨æ╨úT ╨ö╨¢╨ÿH╨½ 01460000 E$INIT EQU X'03' HEBEPH╨½E ╨ƒAPAMETP╨½ INIT 01470000 E$NUM EQU X'04' HEBEPH╨½╨Ö HOMEP ╨ƒAKETA 01480000 E$TYPE EQU X'05' * HEKOPPEKTH╨½╨Ö T╨ÿ╨ƒ ╨ƒAKETA 01490005 E$ERR EQU X'06' * O╨æ╨¢OMA╨¢C╨» ╨ƒAPTHEP 01500005 E$STATE EQU X'07' * HEPAC╨ƒO╨ùHAHHOE COCTO╨»H╨ÿE SEND 01510005 E$PIO EQU X'08' * PERMANENT I/O ERROR 01520005 E$BAD EQU X'09' ╨úTEP╨»H ╨ƒAKET OT ╨ƒAPTHEPA 01530000 E$NAK EQU X'0A' NAK OT ╨ƒAPTHEPA 01540000 E$B37 EQU X'0B' * SYSTEM CODE B37 01550005 E$HSTLEN EQU X'0C' * MO╨» ╨ƒPO╨ôPAMMHA╨» O╨¿╨ÿ╨æKA 01560005 E$SPACE EQU X'0D' * HET MECTA B ╨ñA╨Ö╨¢E 01570005 E$CICS EQU X'0E' * HE╨ƒOH╨»THA╨» O╨¿╨ÿ╨æKA CICS 01580005 E$TRUNC EQU X'0F' ╨ƒEPE╨öAHHA╨» TEKCT. CTPOKA ╨æ╨½╨¢A ╨úCE╨º. 01590000 E$HSTNUM EQU X'10' * MO╨» ╨ƒPO╨ôPAMMHA╨» O╨¿╨ÿ╨æKA 01600005 E$HSTTYP EQU X'11' * MO╨» ╨ƒPO╨ôPAMMHA╨» O╨¿╨ÿ╨æKA 01610005 E$LIMIT EQU X'12' * MO╨» ╨ƒPO╨ôPAMMHA╨» O╨¿╨ÿ╨æKA 01620005 * T╨ÿ╨ƒ╨½ ╨ƒAKETOB 01630000 AA EQU X'41' 'A' B KO╨ÿ-7 01640000 AB EQU X'42' 'B' 01650000 AD EQU X'44' 'D' 01660000 AE EQU X'45' 'E' 01670000 AF EQU X'46' 'F' 01680000 AN EQU X'4E' 'N' 01690000 AS EQU X'53' 'S' 01700000 AY EQU X'59' 'Y' 01710000 AZ EQU X'5A' 'Z' 01720000 *====================================================================== 01730000 R0 EQU 0 01740000 R1 EQU 1 01750000 R2 EQU 2 01760000 R3 EQU 3 01770000 R4 EQU 4 01780000 PPTCBAR EQU 4 ╨æA╨ùA 01790000 R5 EQU 5 01800000 DCTCBAR EQU 5 ╨æA╨ùA 01810000 R6 EQU 6 01820000 TDOABAR EQU 7 ╨æA╨ùA O╨æ╨¢. B╨½BO╨öA DESTINATION 01830000 TDIABAR EQU 8 ╨æA╨ùA O╨æ╨¢. BBO╨öA DESTINATION 01840000 TIOABAR EQU 9 ╨æA╨ùA O╨æ╨¢. BBO╨öA/B╨½BO╨öA TEPM╨ÿHA╨¢A 01850000 TCTTEAR EQU 10 ╨æA╨ùA TA╨æ╨¢. ╨ú╨ƒPAB╨¢EH╨ÿ╨» TEPM╨ÿHA╨¢AM╨ÿ 01860000 BASE EQU 11 ╨æA╨ùA ╨ƒPO╨ôPAMM╨½ 01870000 *TCACBAR EQU 12 01880000 CSACBAR EQU 13 01890000 R14 EQU 14 ! MO╨ûHO ╨ÿC╨ƒO╨¢╨¼╨ùOBAT╨¼ KAK PA╨æO╨º╨ÿE, HO ╨ƒP╨ÿ 01900000 R15 EQU 15 ! B╨½╨ùOBE ╨ƒO╨ö╨ƒPO╨ôPAMM OH╨ÿ ╨ƒOPT╨»TC╨» 01910000 * 01920000 * COPY DFHTCTTE TA╨æ╨¢╨ÿ╨ªA ╨ú╨ƒPAB╨¢EH╨ÿ╨» TEPM╨ÿHA╨¢AM╨ÿ (TCT) 01930000 * COPY DFHTIOA O╨æ╨¢ACT╨¼ BBO╨öA/B╨½BO╨öA TEPM╨ÿHA╨¢A (TIOA) 01940000 * COPY DFHDCTDS TA╨æ╨¢╨ÿ╨ªA ╨ú╨ƒPAB╨¢EH╨ÿ╨» ╨ƒ╨úHKTAM╨ÿ HA╨ùH. (DCT) 01950000 * COPY DFHTDIA O╨æ╨¢ACT╨¼ BBO╨öA TPAH╨ù╨ÿTH╨½X ╨öAHH╨½X (TDIA) 01960000 *UTDIA EQU * 01970000 * COPY DFHTDOA O╨æ╨¢ACT╨¼ B╨½BO╨öA TPAH╨ù╨ÿTH╨½X ╨öAHH╨½X (TDOA) 01980000 * COPY DFHPPTDS 01990000 * COPY DFHCSADS O╨æ╨⌐A╨» C╨ÿCTEMHA╨» O╨æ╨¢ACT╨¼ (CSA) 02000000 * COPY DFHTCADS O╨æ╨¢ACT╨¼ ╨ú╨ƒPAB╨¢EH╨ÿ╨» ╨ùA╨öA╨ºE╨Ö (TCA) 02010000 * 02020000 PRINT OFF 02030000 COPY DFHTCTTE TA╨æ╨¢╨ÿ╨ªA ╨ú╨ƒPAB╨¢EH╨ÿ╨» TEPM╨ÿHA╨¢AM╨ÿ (TCT) 02040000 COPY DFHTIOA O╨æ╨¢ACT╨¼ BBO╨öA/B╨½BO╨öA TEPM╨ÿHA╨¢A (TIOA) 02050000 COPY DFHDCTDS TA╨æ╨¢╨ÿ╨ªA ╨ú╨ƒPAB╨¢EH╨ÿ╨» ╨ƒ╨úHKTAM╨ÿ HA╨ùH. (DCT) 02060000 COPY DFHTDIA O╨æ╨¢ACT╨¼ BBO╨öA TPAH╨ù╨ÿTH╨½X ╨öAHH╨½X (TDIA) 02070000 UTDIA EQU * 02080000 COPY DFHTDOA O╨æ╨¢ACT╨¼ B╨½BO╨öA TPAH╨ù╨ÿTH╨½X ╨öAHH╨½X (TDOA) 02090000 COPY DFHPPTDS 02100000 COPY DFHCSADS O╨æ╨⌐A╨» C╨ÿCTEMHA╨» O╨æ╨¢ACT╨¼ (CSA) 02110000 COPY DFHTCADS O╨æ╨¢ACT╨¼ ╨ú╨ƒPAB╨¢EH╨ÿ╨» ╨ùA╨öA╨ºE╨Ö (TCA) 02120000 PRINT ON,NOGEN 02130000 *====================================================================== 02140000 * TWA COURIER - CICS 02150000 *====================================================================== 02160000 COURTWA EQU * 02170000 *::::::::::::::::: ONLY COURIER ::::::::::::::::::::::::::::::::::::::: 02180000 PROMPT DS CL24 "COURIER" INIT 02190000 TRTNAME DS CL8 ╨ÿM╨» TEK╨ú╨⌐E╨Ö TA╨æ╨¢╨ÿ╨ª╨½ INIT 02200000 NEWTRT DS CL8 ╨ÿM╨» HOBO╨Ö TA╨æ╨¢╨ÿ╨ª╨½ 02210000 * 02220000 PARSELST DS 3F C╨ƒ╨ÿCOK A╨öPECOB ╨ƒAPAMETPOB 02230000 * 02240000 * SAVE AREA 02250000 * 02260000 $ADDR$SV DS 2F B 1 C╨¢OBE =A($SAVE$RG-36) INIT 02270000 ORG *-36 02280000 $ADDR$AS EQU * 02290000 ORG 02300000 $SAVE$RG DS 90F 10 ╨úPOBHE╨Ö B╨¢O╨ûEH╨ÿ╨» ╨ƒPO╨ôPAMM ╨ƒO 9 REG 02310000 *:::::::::::::::: COURIER+COURRS :::::::::::::::::::::::::::::::::::::: 02320000 FILEDEST DS F ╨ÿM╨» ╨ƒ╨úHKTA HA╨ùH. SEND/RECEIVE 02330000 DBGDEST DS F ╨ÿM╨» ╨ƒ╨úHKTA HA╨ùH. DEBUG INIT 02340000 PACKDEST DS F ╨ÿM╨» TEPM╨ÿHA╨¢A INIT 02350000 * 02360000 PACKET DS H 26 <= ? <= 94 INIT 02370000 DELAY DS H 1 <= ? <= 32 767 INIT 02380000 RETRY DS H ╨º╨ÿC╨¢O ╨ƒOBTOPOB ╨ƒAKETA INIT 02390000 QUOTE DS X ╨ƒPE╨ñ╨ÿKC CTRL INIT 02400000 PREF DS X ╨ƒPE╨ñ╨ÿKC 8 ╨æ╨ÿTA INIT 02410000 REPEAT DS X ╨ƒPE╨ñ╨ÿKC ╨ƒOBTOP╨»╨«╨⌐╨ÿXC╨» ╨öAHH╨½X INIT 02420000 R#EOT DS X EOL - RECEIVE INIT 02430000 S#EOT DS X EOL - SEND INIT 02440000 R#SOH DS X SOH - RECEIVE INIT 02450000 S#SOH DS X SOH - SEND INIT 02460000 #ERROR DS X HOMEP O╨¿╨ÿ╨æK╨ÿ INIT 02470004 RETCODE DS X HOMEP O╨¿╨ÿ╨æK╨ÿ ╨ƒPE╨ö. KOMAH╨ö╨½ INIT 02480000 ERRTBL#A DS F A╨öPEC TA╨æ╨¢╨ÿ╨ª╨½ ERROR-COO╨æ╨⌐EH╨ÿ╨Ö 02490000 * 02500000 PGMSTAT DS X CTAT╨úC ╨ƒ.H. ╨ñA╨Ö╨¢A INIT 02510004 * 1... .... SEND / RECEIVE 02520000 * .1.. .... TEXT / BINARY 02530000 * ..1. .... PREFIX ON / OFF 02540000 * ...1 .... REPEAT ON / OFF 02550000 * .... 1... BIGPACK ON / OFF 02560000 * .... .XXX RESERVED 02570000 FILSTAT DS X CTAT╨úC ╨ƒ.H. ╨ñA╨Ö╨¢A INIT 02580000 * 01.. .... EXTRA 02590000 * 11.. .... INTRA 02600000 * ..1. .... INPUT / OUTPUT 02610000 * ...1 .... APPEND ON / OFF 02620000 * .... 10.. F 02630000 * .... 01.. V 02640000 * .... 11.. U 02650000 * .... ..X. RESERVED 02660000 * .... ...1 OPEN / CLOSE 02670000 DBGSTAT DS X CTAT╨úC ╨ƒ.H. ╨ñA╨Ö╨¢A OT╨¢A╨öK╨ÿ INIT 02680000 * 01.. .... EXTRA 02690000 * 11.. .... INTRA 02700000 * ..1. .... INPUT / OUTPUT 02710000 * ...1 .... APPEND ON / OFF 02720000 * .... 10.. F 02730000 * .... 01.. V 02740000 * .... 11.. U 02750000 * .... ..X. RESERVED 02760000 * .... ...1 OPEN / CLOSE 02770000 PRMSTAT DS X CTAT╨úC ╨ƒAPAMETPOB ╨ƒEPE╨öA╨º╨ÿ INIT 02780000 * 00.. .... CHECK 1 02790000 * 01.. .... 2 02800000 * 11.. .... 3 02810000 * ..XX .... RESERVED 02820000 * .... 00.. DEBUG OFF 02830000 * .... 01.. PROTOCOL 02840000 * .... 10.. STATISTIC 02850000 * .... 11.. ON 02860000 * .... ..XX RESERVED 02870000 * SET TABLE 02880000 A#TRT#SI DS F A╨öPEC TA╨æ╨¢. ╨ƒEPEKO╨ö. ╨ÿ╨ù ╨¢╨ÿH╨ÿ╨ÿ INIT 02890000 A#TRT#SO DS F A╨öPEC TA╨æ╨¢. ╨ƒEPEKO╨ö. B ╨¢╨ÿH╨ÿ╨« INIT 02900000 A#TRT#EA DS F A╨öPEC TR TABL ╨ƒP╨ÿ ╨ºTEH╨ÿ╨ÿ ╨ö╨ÿCKA INIT 02910000 A#TRT#AE DS F A╨öPEC TRT ╨ƒP╨ÿ ╨ùA╨ƒ╨ÿC╨ÿ HA ╨ö╨ÿCK INIT 02920000 * 02930000 F#REC DS H MAKC╨ÿMA╨¢╨¼HA╨» ╨ö╨¢╨ÿHA ╨ùA╨ƒ╨ÿC╨ÿ FILE 02940000 D#REC DS H MAKC╨ÿMA╨¢╨¼HA╨» ╨ö╨¢╨ÿHA ╨ùA╨ƒ╨ÿC╨ÿ DEBUG 02950000 I#REC DS H MAKC╨ÿMA╨¢╨¼HA╨» ╨ö╨¢╨ÿHA ╨ùA╨ƒ╨ÿC╨ÿ FILE INTRA 02960000 *::::::::::::::::: ONLY COURRS :::::::::::::::::::::::::::::::::::::::: 02970000 * 02980000 * PSW - PACKET STATUS WORD 02990000 * 03000000 $PSW$CUR EQU * 03010000 $N$CUR DS H NUMBER 03020000 $S$CUR DS X SEND 03030000 $R$CUR DS X RECEIVE 03040000 $PSW$OLD EQU * 03050000 $N$OLD DS H NUMBER 03060000 $S$OLD DS X SEND 03070000 $R$OLD DS X RECEIVE 03080000 * 03090000 $FMA DS F FILE MEMORY ADDRESS 03100000 $DMA DS F DEBUG MEMORY ADDRESS 03110000 $SMA DS F SEND PACKET MEMORY ADDRESS 03120000 $RMA DS F RECEIVE PACKET MEMORY ADDRESS 03130000 * 03140000 $STATE DS X ╨ƒPE╨ö╨½╨ö╨ú╨⌐EE COCTO╨»H╨ÿE ╨ƒPOTOKO╨¢A 03150000 $DAT$A DS F 03160000 $TIME DS CL6 CTAPTOBOE BPEM╨»: HHMMSS 03170000 $SDAT$L DS H ╨ö╨¢╨ÿHA ╨ƒOC╨½╨¢AEMO╨ôO ╨ƒAKETA 03180000 $RDAT$L DS H ╨ö╨¢╨ÿHA ╨ƒP╨ÿH╨»TO╨ôO ╨ƒAKETA 03190000 $RETRY DS H ╨º╨ÿC╨¢O ╨ƒOBTOPEH╨ÿ╨Ö ╨ƒEPE╨öA╨º╨ÿ 03200000 $WR$L DS H ╨ö╨¢╨ÿHA ╨ùA╨ƒ╨ÿC╨ÿ SEND/RECEIVE 03210000 $PUT$L DS H TEK╨ú╨⌐A╨» ╨ƒO╨ù╨ÿ╨ª╨ÿ╨» B ╨ùA╨ƒ╨ÿC╨ÿ 03220000 $GET$L DS H TEK╨ú╨⌐A╨» ╨ƒO╨ù╨ÿ╨ª╨ÿ╨» B ╨ùA╨ƒ╨ÿC╨ÿ 03230000 IND#CRLF DS X TEK╨ú╨⌐A╨» ╨ƒO╨ù╨ÿ╨ª╨ÿ╨» B ╨ùA╨ƒ╨ÿC╨ÿ 03240000 * 03250000 * 03260000 DS 0D 03270000 DBLWRK DS D PA╨æO╨ºA╨» O╨æ╨¢ACT╨¼ 03280000 * 03290000 *--------------------- 03300000 PACKAGE DS CL130 ╨ƒAKET / COO╨æ╨⌐EH╨ÿ╨» 03310000 *--------------------- 03320000 TWALEN EQU *-PROMPT 03330000 *********************************************************************** 03340000 COURIER CSECT 03350000 BALR BASE,0 ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨æA╨ùOB╨½╨Ö PE╨ô╨ÿCTP 03360000 USING *,BASE ╨úCTAHOB╨ÿT╨¼ A╨öPECA╨ª╨ÿ╨« B ╨ƒPO╨ôPAMME 03370000 * 03380000 L TCTTEAR,TCAFCAAA ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC TCTTE 03390000 MVC TCASCSA,TCTTEDA ╨ùA╨ƒ╨ÿCAT╨¼ A╨öPEC HA╨º. TIOA 03400000 DFHSC TYPE=FREEMAIN OCBO╨æO╨ö╨ÿT╨¼ HA╨ºA╨¢╨¼H╨ú╨« TIOA 03410000 * 03420000 XR R3,R3 ! 03430000 STC R3,PROMPT ! 03440000 LA R2,PROMPT ! 03450000 LA R3,1 ! O╨º╨ÿCT╨ÿT╨¼ 03460000 LA R4,PROMPT+1 ! TWA 03470000 LA R5,TWALEN ! 03480000 MVCL R4,R2 ! 03490000 * 03500000 L R1,TCAFCAAA ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC TCTTE 03510000 MVC PACKDEST(4),0(R1) 03520000 L R6,=A(TOLAT) 03530000 TR PACKDEST(4),0(R6) PACKDEST 03540000 * 03550000 LA R14,$ADDR$AS ╨úCTAHOB╨ÿT╨¼ A╨öPECA╨ª╨ÿ╨« ╨ƒEPEXO╨öOB 03560000 ST R14,$ADDR$SV $ADDR$SV 03570000 * 03580000 L R14,=A(ERRTAB) 03590000 ST R14,ERRTBL#A ERRTBL#A 03600000 ** 03610000 L PPTCBAR,CSAPPTBA ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC HA╨ºA╨¢A PPT 03620000 PRED02 CLC PPTPI(8),=C'COURSTND' HA╨¿╨¢╨ÿ ╨ÿM╨» TA╨æ╨¢╨ÿ╨ª╨½ B PPT ? 03630000 BE PRED05 EC╨¢╨ÿ COB╨ƒA╨¢╨ÿ, TO TRT HA╨Ö╨öEHA 03640000 CLI PPTPI,X'FF' ╨öO╨¿╨¢╨ÿ ╨öO KOH╨ªA PPT ? 03650000 BE PRED04 EC╨¢╨ÿ ╨öA, TO TA╨æ╨¢╨ÿ╨ª╨½ HET 03660000 L R1,PPTNXTEN ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC C╨¢E╨ö. PPT 03670000 LR PPTCBAR,R1 ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC C╨¢E╨ö. PPT 03680000 B PRED02 ╨ÿ ╨ÿCKAT╨¼ ╨öA╨¢╨¼╨¿E 03690000 PRED04 WRMESS 'STANDARD TRANSLATE TABLE -COURSTND- IS NOT DEFINED!' 03700000 B THEEND 03710000 PRED05 EQU * 03720000 MVC TCAPCPI(8),=C'COURSTND' ╨ùA╨ƒ╨ÿCAT╨¼ ╨ÿM╨» ╨ùA╨ôP╨ú╨ûAEMO╨Ö TRT 03730000 DFHPC TYPE=LOAD ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ TA╨æ╨¢╨ÿ╨ª╨½ 03740000 L R5,TCAPCLA ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC TA╨æ╨¢╨ÿ╨ª 03750000 ST R5,A#TRT#SO A╨öPEC TA╨æ╨¢. ╨ƒEPEKO╨ö. B ╨¢╨ÿH╨ÿ╨« (ATOE) 03760000 LA R5,256(,R5) ╨ƒO╨¢╨ú╨º╨ÿT╨¼ A╨öPEC TA╨æ╨¢╨ÿ╨ª╨½ 03770000 ST R5,A#TRT#SI A╨öPEC TA╨æ╨¢. ╨ƒEPEKO╨ö. ╨ÿ╨ù ╨¢╨ÿH╨ÿ╨ÿ (ETOA) 03780000 ** 03790000 CALL INITIATE 03800000 BRTORC COUR020,REST=COUR010 03810000 COUR010 WRMESS 'STANDARD TRANSLATE TABLE -COURTRTS- IS NOT DEFINED!' 03820000 COUR020 EQU * 03830000 * 03840000 MVC DBGDEST(4),=C'CSSL' DBGDEST 03850000 * 03860000 * ╨ÿH╨ÿ╨ª╨ÿA╨¢╨ÿ╨ùA╨ª╨ÿ╨» ╨ùAKOH╨ºEHA 03870000 * 03880000 WRMESS 'KERMIT PROTOCOL PROGRAM FRANK DA KRUZ NEW YORK ' 03890007 WRMESS 'COURIER-CICS VERSION 2.20 ICSTI MOSCOW ' 03900007 *********************************************************************** 03910000 * OCHOBHO╨Ö ╨ª╨ÿK╨¢ O╨æPA╨æOTK╨ÿ KOMAH╨ö * 03920000 *********************************************************************** 03930000 PROMPTS XR R14,R14 03940000 IC R14,PROMPT 03950000 EX R14,PROMPTMV 03960000 CALL WRITMS B╨½BO╨ö PROMPT 03970000 CALL RDTRM ╨º╨ÿTAT╨¼ C TEPM╨ÿHA╨¢A 03980000 LM R1,R3,PARSELST ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPECA O╨ƒEPAH╨öOB 03990000 * 04000000 CLI 0(R1),C' ' H╨ÿ╨ºE╨ôO HE BBE╨öEHO ? 04010000 BNE PRSET 04020000 WRMESS 'KERMIT PROTOCOL PROGRAM FRANK DA KRUZ NEW YORK ' 04030006 WRMESS 'COURIER-CICS VERSION 2.20 ICSTI MOSCOW ' 04040006 B PROMPTS 04050000 *---------------------------------------------------------------------* 04060000 PRSET CLC 0(3,R1),=C'SET' SET ? 04070000 BNE PRSTATUS ╨úB╨½.. 04080000 CLI 0(R2),C' ' ECT╨¼ O╨ƒEPAH╨ö╨½ ? 04090000 BE PROMPTS ╨úB╨½.. 04100000 CLI 0(R2),C'?' ╨ùA╨ƒPO╨¿EH HELP ? 04110000 BNE PRSET01 ╨úB╨½.. 04120000 WRMESS 'APPEND, DEBUG, DELAY, FILE, PACKET,' 04130003 WRMESS 'PREFIX, PROMPT, QUOTE, RECORD, RETRY, TRT.' 04140002 B PROMPTS 04150000 PRSET01 CALL SET 04160000 BRTORC PROMPTS,REST=PRSET02 ╨ƒPOBEP╨ÿT╨¼ KO╨ö BO╨ùBPATA 04170000 PRSET02 WRMESS 'ILLEGAL SET COMMAND.' 04180000 B PROMPTS 04190000 *---------------------------------------------------------------------* 04200000 PRSTATUS CLC 0(3,R1),=C'STA' STATUS ? 04210000 BNE PRSHOW ╨úB╨½.. 04220000 CLI 0(R2),C' ' ECT╨¼ O╨ƒEPAH╨ö╨½ ? 04230000 BE PRSTA01 ╨úB╨½.. 04240000 CLI 0(R2),C'?' ╨ùA╨ƒPO╨¿EH HELP ? 04250000 BNE PRSTA03 ╨úB╨½.. 04260000 WRMESS 'CONFIRM WITH A CARRIAGE RETURN.' 04270000 B PROMPTS 04280000 PRSTA01 EQU * 04290000 CALL STATUS 04300000 B PROMPTS 04310000 PRSTA03 WRMESS 'ILLEGAL STATUS COMMAND.' 04320000 B PROMPTS 04330000 *---------------------------------------------------------------------* 04340000 PRSHOW CLC 0(3,R1),=C'SHO' SHOW ? 04350000 BNE PRREC 04360000 CLI 0(R2),C' ' ECT╨¼ O╨ƒEPAH╨ö╨½ ? 04370000 BE PROMPTS ╨úB╨½.. 04380000 CLI 0(R2),C'?' ╨ùA╨ƒPO╨¿EH HELP ? 04390000 BNE PRSHO01 ╨úB╨½.. 04400000 WRMESS 'PARM OR TRT OR DESTINATION.' 04410000 B PROMPTS 04420000 PRSHO01 CALL SHOW 04430000 BRTORC PROMPTS,REST=PRSHO02 04440000 PRSHO02 WRMESS 'ILLEGAL SHOW COMMAND.' 04450000 B PROMPTS 04460000 *---------------------------------------------------------------------* 04470000 PRREC CLC 0(3,R1),=C'REC' RECEIVE ? 04480000 BNE PRSEND ╨úB╨½.. 04490000 NI PGMSTAT,X'FF'-X'80' SET RECEIVE 04500000 B PRRS 04510000 PRSEND CLC 0(3,R1),=C'SEN' SEND ? 04520000 BNE PREXIT ╨úB╨½.. 04530000 OI PGMSTAT,X'80' SET SEND 04540000 * 04550000 PRRS EQU * 04560000 CLI 0(R2),C'?' HELP ? 04570000 BNE PRRS010 ╨úB╨½.. 04580000 WRMESS 'SPECIFY DESTINATION_NAME.' 04590000 B PROMPTS 04600000 * 04610000 PRRS010 CLI 0(R2),C' ' ECT╨¼ FILEDEST ? 04620000 BNE PRRS030 ╨öA 04630000 PRRS020 WRMESS 'ENTER DESTINATION_NAME: ' 04640000 CALL RDTRM C╨º╨ÿTAT╨¼ OTBET ╨ƒO╨¢╨¼╨ùOBATE╨¢╨» 04650000 LM R2,R3,PARSELST ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPECA O╨ƒEPAH╨öOB 04660000 CLI 0(R2),C' ' ╨æ╨½╨¢O ╨ºTO-H╨ÿ╨æ╨ú╨ö╨¼ BBE╨öEHO ? 04670000 BE PRRS020 EC╨¢╨ÿ HET, TO C╨º╨ÿT╨½BAT╨¼ CHOBA 04680000 * 04690000 PRRS030 EQU * 04700000 CLC QUOTE(1),PREF C╨ÿMBO╨¢╨½ ╨ƒPE╨ñ╨ÿKCA╨ª╨ÿ╨ÿ COB╨ƒA╨öA╨«T ? 04710000 BNE PRRS035 HET 04720000 WRMESS 'QUOTE = PREF. ILLEGAL.' 04730000 B PROMPTS 04740000 PRRS035 EQU * 04750000 MVI #ERROR,E$OK C╨æPOC╨ÿT╨¼ ╨ÿH╨ö╨ÿKATOP O╨¿╨ÿ╨æK╨ÿ 04760000 MVC FILEDEST(4),0(R2) ╨ÿM╨» ╨ƒ╨úHKTA HA╨ùHA╨ºEH╨ÿ╨» -> TWA 04770000 LA R1,=C'F' 04780000 CALL TSTDEST TEST FILE 04790000 BRTORC PRRS040,REST=PRRS100 04800000 PRRS040 EQU * 04810000 TM FILSTAT,X'C0' DEST INTRA ? 04820000 BO PRRS050 ╨öA 04830000 TM FILSTAT,X'01' FILE OPEN ? 04840000 BO PRRS041 ╨öA 04850000 WRMESS 'SORRY, BAT FILE IS CLOSE.' 04860000 B PROMPTS 04870000 PRRS041 TM PGMSTAT,X'80' SEND ? 04880000 BO PRRS042 ╨öA 04890000 TM FILSTAT,X'20' FILE OUTPUT ? 04900000 BZ PRRS060 ╨öA 04910000 WRMESS 'SORRY, BAT FILE IS READ ONLY.' 04920000 B PROMPTS 04930000 PRRS042 TM FILSTAT,X'20' FILE INPUT ? 04940000 BO PRRS060 ╨öA 04950000 WRMESS 'SORRY, BAT FILE IS WRITE ONLY.' 04960000 B PROMPTS 04970000 * 04980000 PRRS050 EQU * 04990000 TM FILSTAT,X'10' APPEND ON ? 05000000 BO PRRS060 ╨öA 05010000 TM PGMSTAT,X'80' SEND ? 05020000 BO PRRS060 ╨öA 05030000 MVC TCATDDI(4),FILEDEST 05040000 DFHTD TYPE=PURGE 05050000 * 05060000 PRRS060 TM PGMSTAT,X'0C' DEBUG OFF ? 05070000 BZ PRRS080 ╨öA 05080000 LA R1,=C'D' 05090000 CALL TSTDEST 05100000 BRTORC PRRS070,REST=PRRS100 05110000 * 05120000 PRRS070 EQU * 05130000 TM FILSTAT,X'01' FILE OPEN ? 05140000 BO PRRS075 ╨öA 05150000 WRMESS 'SORRY, BAT DEBUG FILE IS CLOSE.' 05160000 B PROMPTS 05170000 * 05180000 PRRS075 TM DBGSTAT,X'20' FILE OUTPUT ? 05190000 BZ PRRS080 ╨öA 05200000 WRMESS 'SORRY, BAT DEBUG FILE IS READ ONLY.' 05210000 B PROMPTS 05220000 * 05230000 PRRS080 CALL COURRS 05240000 LR R2,R14 05250000 CALL RDTRM 05260000 LR R14,R2 05270000 BRTORC PRRS200,REST=PRRS300 05280000 * 05290000 PRRS100 WRMESS 'DESTINATION NAME IS NOT DEFINED OR BAD.' 05300000 MVI #ERROR,E$OK 05310000 MVC RETCODE(1),#ERROR 05320000 B PROMPTS 05330000 PRRS200 TM PGMSTAT,X'80' SEND ? 05340000 BO PRRS220 ╨öA 05350000 WRMESS 'RECEIVING COMPLETE.' 05360000 B PRRS240 05370000 PRRS220 WRMESS 'SENDING COMPLETE.' 05380000 PRRS240 MVI #ERROR,E$OK 05390000 MVC RETCODE(1),#ERROR 05400000 B PROMPTS 05410000 PRRS300 TM PGMSTAT,X'80' SEND ? 05420000 BO PRRS320 ╨öA 05430000 WRMESS 'RECEIVING ERROR. TRY AGAIN.' 05440000 B PRRS340 05450000 PRRS320 WRMESS 'SENDING ERROR. TRY AGAIN.' 05460000 PRRS340 MVC RETCODE(1),#ERROR 05470000 B PROMPTS 05480000 *---------------------------------------------------------------------* 05490000 PREXIT CLI 0(R1),C'E' EXIT ? 05500000 BE PREXIT01 ╨öA 05510000 CLI 0(R1),C'Q' QUIT ? 05520000 BNE PRHELP ╨úB╨½.. 05530000 PREXIT01 CLI 0(R2),C' ' ECT╨¼ O╨ƒEPAH╨ö╨½ ? 05540000 BE THEEND ╨úB╨½.. 05550000 CLI 0(R2),C'?' ╨ùA╨ƒPO╨¿EH HELP ? 05560000 BNE PREXIT02 ╨úB╨½.. 05570000 WRMESS 'CONFIRM WITH A CARRIAGE RETURN.' 05580000 B PROMPTS 05590000 PREXIT02 WRMESS 'ILLEGAL EXIT OR QUIT COMMAND.' 05600000 B PROMPTS 05610000 THEEND WRMESS 'COURIER COMPLETED.' 05620000 DFHPC TYPE=RETURN 05630000 *---------------------------------------------------------------------* 05640000 PRHELP CLC 0(3,R1),=C'HEL' HELP ? 05650000 BNE PRQWEST ╨úB╨½.. 05660000 CLI 0(R2),C'?' ╨ùA╨ƒPO╨¿EH HELP HELP ? 05670000 BE PRHEL01 EC╨¢╨ÿ ╨öA, B╨½╨öAT╨¼ CONFIRM WITH... 05680000 WRMESS 'ENTER ? AT PROMPTS TO RECEIVE LIST OF COMMANDS.' 05690000 WRMESS 'ENTER ? AFTER COMMAND TO RECEIVE LIST OF OPERANDS.' 05700000 B PROMPTS 05710000 PRHEL01 WRMESS 'CONFIRM WITH A CARRIAGE RETURN.' 05720000 B PROMPTS 05730000 *---------------------------------------------------------------------* 05740000 PRQWEST CLC 0(1,R1),=C'?' HELP ? 05750000 BNE PRERROR ╨úB╨½.. 05760000 WRMESS 'LEGAL COMMANDS ARE:' 05770000 WRMESS 'RECEIVE, SEND, HELP, QUIT,' 05780000 WRMESS 'EXIT, SET, STATUS, SHOW, ?.' 05790000 B PROMPTS 05800000 *---------------------------------------------------------------------* 05810000 PRERROR WRMESS 'ILLEGAL COMMAND. ENTER HELP ,PLEASE.' 05820000 B PROMPTS 05830000 *---------------------------------------------------------------------* 05840000 PROMPTMV MVC PACKAGE(0),PROMPT 05850000 ERRTAB DC CL30'PROCESS OK!' ERR MSG #00 05860000 DC CL30'BAD CHECKSUM' ERR MSG #01 05870000 DC CL30'ILLEGAL PACKET LENGHT' ERR MSG #02 05880000 DC CL30'BAD INIT PARM' ERR MSG #03 05890000 DC CL30'BAD PACKET NUMBER' ERR MSG #04 05900000 DC CL30'ILLEGAL PACKET TYPE' ERR MSG #05 05910000 DC CL30'MICRO COMPUTER ABORTED' ERR MSG #06 05920000 DC CL30'SEND TYPE ILLEGAL.' ERR MSG #07 05930000 DC CL30'PERMANENT I/O ERROR' ERR MSG #08 05940000 * 05950000 DC CL30'LOST A PACKET' ERR MSG #09 05960000 DC CL30'MICRO SENT A NAK' ERR MSG #0A 05970000 DC CL30'INTRA DESTINATION FULL' ERR MSG #0B 05980000 DC CL30'HOST PACKET ERROR. LENGHT' ERR MSG #0C 05990000 DC CL30'FILE IS FULL' ERR MSG #0D 06000000 DC CL30'CICS FANTASTIC ERROR' ERR MSG #0E 06010000 DC CL30'LINE HAS BEEN TRUNCATED' ERR MSG #0F 06020000 DC CL30'HOST PACKET ERROR. NUMBER' ERR MSG #10 06030000 DC CL30'HOST PACKET ERROR. TYPE' ERR MSG #11 06040000 DC CL30'LIMIT ERROR.' ERR MSG #12 06050005 TOLAT DC 256AL1(*-TOLAT) 06060000 ORG TOLAT+X'76' 06070000 DC C'U B' 06080000 ORG TOLAT+X'80' 06090000 DC C'CABCDEFGHID FG IJJKLMNOPQRKLM' 06100000 DC C'N PJ STUVWXYZ TUVWXYZSESCWU BCDEFG ' 06110000 ORG TOLAT+X'CB' 06120000 DC C'IJ L' 06130000 ORG TOLAT+X'DC' 06140000 DC C'PJ' 06150000 ORG TOLAT+X'EB' 06160000 DC C'UV XY' 06170000 ORG TOLAT+X'FA' 06180000 DC C'ZSESC' 06190000 *********************************************************************** 06200000 LTORG 06210000 DROP BASE 06220000 *********************************************************************** 06230000 * ╨ƒO╨ö╨ƒPO╨ôPAMMA INITIATE * 06240000 *********************************************************************** 06250000 * RETURN CODE = 0 - OK * 06260000 * RETURN CODE = 2 - HE HA╨Ö╨öEH MO╨ö╨ú╨¢╨¼ COURTRTS B COURIER.LOADLIB * 06270000 *********************************************************************** 06280000 INITIATE SAVE 06290000 USING INITIATE,BASE 06300000 LR BASE,R14 06310000 * 06320000 MVC PROMPT+1(14),=C'COURIER-CICS> ' 06330006 LA R1,14 06340000 STC R1,PROMPT PROMPT 06350000 MVC PACKET(2),=H'94' PACKET = 94 BYTE 06360000 MVC DELAY(2),=H'30' DELAY = 30 SEC 06370000 MVC RETRY(2),=H'5' RETRY = 5 06380000 MVC I#REC(2),=H'4096' I#REC = 4K 06390000 * 06400000 MVI QUOTE,X'23' QUOTE = # ASCII 06410000 MVI PREF,X'26' PREF = & ASCII 06420000 MVI REPEAT,X'7E' REPEAT = ╨º ASCII 06430000 MVI R#SOH,X'02' R#SOH CTRL-B 06440000 MVI R#EOT,X'04' R#EOT CTRL-D 06450000 MVI S#SOH,X'02' S#SOH CTRL-B 06460000 MVI S#EOT,X'04' S#EOT CTRL-D 06470000 * 06480000 MVI #ERROR,E$OK #ERROR 06490000 MVI RETCODE,E$OK RETCODE 06500000 * 06510000 OI PGMSTAT,X'40' SET FILE TEXT 06520000 * NI PGMSTAT,X'FF'-X'40' SET FILE BINARY 06530000 OI PGMSTAT,X'20' SET PREF ON 06540000 * NI PGMSTAT,X'FF'-X'20' SET PREF OFF 06550000 * OI PGMSTAT,X'10' SET REPEAT ON 06560000 NI PGMSTAT,X'FF'-X'10' SET REPEAT OFF 06570000 * OI PGMSTAT,X'08' SET BIGPACK ON 06580000 NI PGMSTAT,X'FF'-X'08' SET BIGPACK OFF 06590000 * OI FILSTAT,X'10' SET APPEND ON FILE 06600000 NI FILSTAT,X'FF'-X'10' SET APPEND OFF FILE 06610000 * OI DBGSTAT,X'10' SET APPEND ON DEBUG 06620000 NI DBGSTAT,X'FF'-X'10' SET APPEND OFF DEBUG 06630000 * 06640000 NI PRMSTAT,X'FF'-X'C0' SET CHECK 1 06650000 * OI PRMSTAT,X'40' SET CHECK 2 06660000 * NI PRMSTAT,X'FF'-X'80' SET CHECK 2 06670000 * OI PRMSTAT,X'C0' SET CHECK 3 06680000 * 06690000 MVC NEWTRT(8),=C'COURTRTS' 06700000 LA R3,=C'S' 06710000 CALL SETTRT 06720000 BRTORC INIT020,REST=INIT010 06730000 INIT010 LA R14,2 RC = 2 06740000 B INITRET 06750000 * 06760000 INIT020 XR R14,R14 RC = 0 06770000 INITRET RETURN 06780000 *********************************************************************** 06790000 LTORG 06800000 DROP BASE 06810000 *********************************************************************** 06820000 * ╨ƒO╨ö╨ƒPO╨ôPAMMA ╨ºTEH╨ÿ╨» KOMAH╨ö * 06830000 *********************************************************************** 06840000 * RETURN CODE = 0 - OK * 06850000 *********************************************************************** 06860000 RDTRM SAVE 06870000 USING RDTRM,BASE 06880000 LR BASE,R14 06890000 DFHTC TYPE=GET 06900000 L TIOABAR,TCTTEDA ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC TIOA 06910000 LH R1,TIOATDL ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú TIOA 06920000 CH R1,=H'129' CPABH╨ÿT╨¼ C MAKC╨ÿM. ╨ö╨¢╨ÿHO╨Ö 06930000 BNH RDT010 EC╨¢╨ÿ HE ╨æO╨¢╨¼╨¿E, OCTAB╨ÿT╨¼ 06940000 LA R1,129 ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ MAKC╨ÿM. ╨ö╨¢╨ÿH╨ú 06950000 RDT010 MVI PACKAGE,C' ' C╨ÿMBO╨¢ - ╨ùA╨ƒO╨¢H╨ÿTE╨¢╨¼ 06960000 MVC PACKAGE+1(129),PACKAGE 06970000 LA R2,PACKAGE+129 ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC ╨ƒPO╨æE╨¢A 06980000 LR R3,R2 CKO╨ƒ╨ÿPOBAT╨¼ 06990000 LR R4,R2 E╨⌐E PA╨ù CKO╨ƒ╨ÿPOBAT╨¼ 07000000 STM R2,R4,PARSELST ╨ùA╨ƒ╨ÿCAT╨¼ BCE A╨öPECA B PARSELST 07010000 LTR R1,R1 ECT╨¼ ╨öAHH╨½E B TIOA ? 07020000 BZ RDT200 EC╨¢╨ÿ HET, CPA╨ù╨ú OCBO╨æO╨ö╨ÿT╨¼ 07030000 LA R3,TIOADBA A╨öPEC BXO╨öHO╨Ö O╨æ╨¢ACT╨ÿ 07040000 LA R4,PACKAGE A╨öPEC B╨½XO╨öHO╨Ö O╨æ╨¢ACT╨ÿ 07050000 RDT020 CLI 0(R3),C' ' H╨ú╨ûH╨½ TO╨¢╨¼KO ╨ƒE╨ºATH╨½E C╨ÿMBO╨¢╨½ 07060000 BL RDT030 EC╨¢╨ÿ MEH╨¼╨¿E, TO ╨ƒPO╨ƒ╨úCT╨ÿT╨¼ 07070000 MVC 0(1,R4),0(R3) ╨ùA╨ƒ╨ÿCAT╨¼ C╨ÿMBO╨¢ 07080000 LA R4,1(,R4) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ 07090000 RDT030 LA R3,1(,R3) ╨ƒEPEMECT╨ÿT╨¼ BXO╨öHO╨Ö ╨úKA╨ùATE╨¢╨¼ 07100000 BCT R1,RDT020 ╨ÿ ╨ƒPOBEP╨»T╨¼ C╨¢E╨ö╨ú╨«╨⌐╨ÿ╨Ö 07110000 * PA╨ù╨öE╨¢╨ÿT╨¼ KOMAH╨ö╨ú HA O╨ƒEPAH╨ö╨½ 07120000 LA R1,3 MAKC╨ÿM. ╨º╨ÿC╨¢O O╨ƒEPAH╨öOB 07130000 LA R2,PARSELST A╨öPEC C╨ƒ╨ÿCKA O╨ƒEPAH╨öOB 07140000 LA R5,PACKAGE A╨öPEC BXO╨öHO╨Ö O╨æ╨¢ACT╨ÿ 07150000 SR R4,R5 ╨ƒO╨¢╨ú╨º╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú ╨öAHH╨½X 07160000 BZ RDT200 EC╨¢╨ÿ HET ╨öAHH╨½X, TO B╨½XO╨ö 07170000 RDT100 CLI 0(R5),C' ' BCE ╨ƒPO╨æE╨¢╨½ ╨ƒPO╨ƒ╨úCKAT╨¼ 07180000 BNE RDT120 EC╨¢╨ÿ HE ╨ƒPO╨æE╨¢, TO HA╨Ö╨öEH O╨ƒEPAH╨ö 07190000 LA R5,1(,R5) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ 07200000 BCT R4,RDT100 ╨ÿ CMOTPET╨¼ C╨¢E╨ö. C╨ÿMBO╨¢ 07210000 B RDT200 BCE ╨öAHH╨½E O╨æPA╨æOTAH╨½ 07220000 RDT120 ST R5,0(,R2) ╨ùA╨ƒ╨ÿCAT╨¼ A╨öPEC O╨ƒEPAH╨öA 07230000 LA R2,4(,R2) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ HA PARSELST 07240000 RDT140 LA R5,1(,R5) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ 07250000 CLI 0(R5),C' ' HA╨Ö╨öEH KOHE╨ª O╨ƒEPAH╨öA ? 07260000 BE RDT160 EC╨¢╨ÿ ╨öA, ╨ƒPO╨ƒ╨úCKAT╨¼ ╨ƒPO╨æE╨¢╨½ 07270000 BCT R4,RDT140 ╨ƒPOBEP╨»T╨¼ C╨¢E╨ö. C╨ÿMBO╨¢ 07280000 B RDT200 BCE ╨öAHH╨½E O╨æPA╨æOTAH╨½ 07290000 RDT160 BCT R1,RDT100 EC╨¢╨ÿ O╨ƒEPAH╨öOB < 3, ╨ÿCKAT╨¼ C╨¢E╨ö. 07300000 RDT200 ST TIOABAR,TCASCSA OCBO╨æO╨ö╨ÿT╨¼ TIOA 07310000 DFHSC TYPE=FREEMAIN 07320000 L R6,=A(UPPER) 07330000 TR PACKAGE(130),0(R6) ╨ƒEPEBECT╨ÿ B BEPXH╨ÿ╨Ö PE╨ô╨ÿCTP 07340000 XR R14,R14 RC=0 07350000 RETURN 07360000 UPPER DC 256AL1(*-UPPER) 07370000 ORG UPPER+X'81' 07380000 DC C'ABCDEFGHI' 07390000 ORG UPPER+X'91' 07400000 DC C'JKLMNOPQR' 07410000 ORG UPPER+X'A2' 07420000 DC C'STUVWXYZ' 07430000 ORG UPPER+256 07440000 *********************************************************************** 07450000 LTORG 07460000 DROP BASE 07470000 *********************************************************************** 07480000 * B╨½BO╨ö COO╨æ╨⌐EH╨ÿ╨Ö COURIER - CICS * 07490000 *********************************************************************** 07500000 * RETURN CODE = 0 - OK * 07510000 *********************************************************************** 07520000 WRITMS SAVE 07530000 USING WRITMS,BASE ╨úCTAHOB╨ÿT╨¼ A╨öPECA╨ª╨ÿ╨« 07540000 LR BASE,R14 ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨æA╨ùOB╨½╨Ö PE╨ô╨ÿCTP 07550000 XR R2,R2 ╨ö╨¢╨» ╨ùA╨ôP╨ú╨ùK╨ÿ ╨ö╨¢╨ÿH╨½ COO╨æ╨⌐EH╨ÿ╨» 07560000 IC R2,PACKAGE ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú 07570000 LA R3,2(,R2) ╨ö╨¢╨ÿHA CR LF 07580000 STH R3,TCASCNB ╨ùA╨ƒ╨ÿCAT╨¼ ╨ö╨¢╨ÿH╨ú TIOA 07590000 DFHSC TYPE=GETMAIN,CLASS=TERMINAL ╨ùA╨ƒPOC╨ÿT╨¼ TIOA 07600000 L TIOABAR,TCASCSA ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC TIOA 07610000 STH R3,TIOATDL ╨ùA╨ƒ╨ÿCAT╨¼ ╨ö╨¢╨ÿH╨ú TIOA 07620000 MVC TIOADBA(2),=X'0D25' ╨ùA╨ƒ╨ÿCAT╨¼ CR LF 07630000 BCTR R2,0 B╨½╨ºECT╨¼ 1 ╨ö╨¢╨» MVC 07640000 EX R2,WRMSTXT ╨ùA╨ƒ╨ÿCAT╨¼ TEKCT COO╨æ╨⌐EH╨ÿ╨» 07650000 ST TIOABAR,TCTTEDA ╨ùA╨ƒ╨ÿCAT╨¼ A╨öPEC TIOA B TCTTE 07660000 DFHTC TYPE=PUT B╨½BECT╨ÿ COO╨æ╨⌐EH╨ÿE 07670000 XR R14,R14 RC=0 07680000 B WRI##010 07690000 WRMSTXT MVC TIOADBA+2(0),PACKAGE+1 07700000 WRI##010 RETURN 07710000 *********************************************************************** 07720000 LTORG 07730000 DROP BASE 07740000 *********************************************************************** 07750000 * ╨ƒO╨ö╨ƒPO╨ôPAMMA TSTDEST * 07760000 *********************************************************************** 07770000 * METO╨ö ╨öOCT╨ú╨ƒA QSAM * 07780000 * RETURN CODE = 0 - OK * 07790000 * RETURN CODE = 2 - DESTINATION NOT DEFINED IN DCT * 07800000 * RETURN CODE = 4 - INCORRECT DESTINATION * 07810000 * RETURN CODE = 6 - INCORRECT I/O REQUEST * 07820000 * RETURN CODE = 8 - INCORRECT TEST QUESTION * 07830000 *********************************************************************** 07840000 TSTDEST SAVE 07850000 USING TSTDEST,BASE 07860000 LR BASE,R14 07870000 XR R14,R14 07880000 CLI 0(R1),C'F' TEST FILE ? 07890000 BE TSTD010 ╨öA 07900000 CLI 0(R1),C'D' TEST DEBUG ? 07910000 BE TSTD020 ╨öA 07920000 LA R14,8 RC = 8 07930000 B TSTD900 07940000 TSTD010 LA R4,FILEDEST 07950000 LA R2,FILSTAT 07960000 LA R3,F#REC 07970000 B TSTD030 07980000 TSTD020 LA R4,DBGDEST 07990000 LA R2,DBGSTAT 08000000 LA R3,D#REC 08010000 * 08020000 TSTD030 EQU * 08030000 L DCTCBAR,CSADCTBA TO╨ºKA BXO╨öA 1-╨ôO DCT 08040000 TSTD040 CLI TDDCTDID,X'FF' ╨¡TO DCT ? 08050000 BE TSTD700 ╨úB╨½.. 08060000 CLC TDDCTDID(4),0(R4) ╨ÿM╨» ╨ƒ.H. O╨ƒPE╨öE╨¢EHO B DCT ? 08070000 BE TSTD050 ╨öA 08080000 TM TDDCTDT,TDINDBM 08090000 BNO TSTD041 08100000 LA DCTCBAR,TDDCTIDD C╨¢E╨ö╨ú╨«╨⌐A╨» DCT 08110000 B TSTD040 08120000 TSTD041 TM TDDCTDT,TDINDTBM 08130000 BNO TSTD042 08140000 LA DCTCBAR,TDDCTIND C╨¢E╨ö╨ú╨«╨⌐A╨» DCT 08150000 B TSTD040 08160000 TSTD042 LA DCTCBAR,TDDCTEXD C╨¢E╨ö╨ú╨«╨⌐A╨» DCT 08170000 B TSTD040 08180000 * 08190000 TSTD050 TM TDDCTDT,TDINDTBM INTRA ? 08200000 BNO TSTD060 ╨úB╨½.. 08210000 OI 0(R2),X'C0' SET INTRA (11.. ....) 08220000 OI 0(R2),X'01' SET OPEN (.... ...1) 08230000 OI 0(R2),X'04' SET V 08240000 NI 0(R2),X'FF'-X'08' SET V (.... 01..) 08250000 XR R15,R15 ! INTRA LRECL NOT DEFINED 08260000 STH R15,0(R3) ! ╨ö╨¢╨ÿHA ╨ùA╨ƒ╨ÿC╨ÿ -> ?#REC 08270000 XR R14,R14 RC = 0 08280000 B TSTD900 08290000 * 08300000 TSTD060 TM TDDCTDT,TDEXTRBM EXTRA ? 08310000 BO TSTD070 ╨öA 08320000 LA R14,4 RC = 4 08330000 B TSTD900 08340000 * 08350000 TSTD070 OI 0(R2),X'40' SET EXTRA 08360000 NI 0(R2),X'FF'-X'80' SET EXTRA (01.. ....) 08370000 XC PACKAGE(4),PACKAGE 08380000 MVC PACKAGE+1(3),TDDCTCBA+1 08390000 L R5,PACKAGE A╨öPEC DCB 08400000 TM 48(R5),X'10' OPEN ? 08410000 BO TSTD071 ╨öA 08420000 NI 0(R2),X'FF'-X'01' SET NOT OPEN (.... ...0) 08430000 XR R14,R14 RC = 0 08440000 B TSTD900 08450000 TSTD071 OI 0(R2),X'01' SET OPEN (.... ...1) 08460000 * 08470000 TSTD080 EQU * 08480000 LR R14,R5 08490000 S R14,=F'4' 08500000 CLI 0(R14),X'0F' OUTPUT ? 08510000 BE TSTD082 ╨öA 08520000 CLI 0(R14),X'00' INPUT ? 08530000 BE TSTD081 08540000 LA R14,6 RC = 6 08550000 B TSTD900 08560000 * 08570000 TSTD081 EQU * 08580000 OI 0(R2),X'20' SET INPUT (..1. ....) 08590000 B TSTD090 08600000 TSTD082 EQU * 08610000 NI 0(R2),X'FF'-X'20' SET OUTPUT (..0. ....) 08620000 B TSTD090 08630000 * 08640000 TSTD090 TM 26(R5),X'40' DSORG = PS ? 08650000 BO TSTD100 ╨öA 08660000 LA R14,4 RC = 4 08670000 B TSTD900 08680000 * 08690000 TSTD100 TM 36(R5),X'C0' RECFM = U ? 08700000 BNO TSTD110 HET 08710000 OI 0(R2),X'0C' SET U (.... 11..) 08720000 MVC 0(2,R3),82(R5) ! ╨ö╨¢╨ÿHA ╨æ╨¢OKA -> ?#REC 08730000 XR R14,R14 RC = 0 08740000 B TSTD900 08750000 * 08760000 TSTD110 TM 36(R5),X'80' RECFM = F ? 08770000 BNO TSTD120 HET 08780000 OI 0(R2),X'08' SET F 08790000 NI 0(R2),X'FF'-X'04' SET F (.... 10..) 08800000 MVC 0(2,R3),82(R5) ! ╨ö╨¢╨ÿHA ╨ùA╨ƒ╨ÿC╨ÿ -> ?#REC 08810000 XR R14,R14 RC = 0 08820000 B TSTD900 08830000 * 08840000 TSTD120 OI 0(R2),X'04' SET V 08850000 NI 0(R2),X'FF'-X'08' SET V (.... 01..) 08860000 MVC 0(2,R3),82(R5) ! ╨ö╨¢╨ÿHA ╨ùA╨ƒ╨ÿC╨ÿ -> ?#REC 08870000 XR R14,R14 RC = 0 08880000 B TSTD900 08890000 * 08900000 TSTD700 LA R14,2 RC = 2 08910000 TSTD900 RETURN 08920000 *********************************************************************** 08930000 LTORG 08940000 DROP BASE 08950000 *********************************************************************** 08960000 * O╨æPA╨æOTKA KOMAH╨ö╨½ S T A T U S * 08970000 *********************************************************************** 08980000 * RETURN CODE = 0 - OK * 08990000 *********************************************************************** 09000000 STATUS SAVE 09010000 USING STATUS,BASE 09020000 LR BASE,R14 09030000 XR R3,R3 O╨º╨ÿCT╨ÿT╨¼ 09040000 IC R3,RETCODE ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ KO╨ö O╨¿╨ÿ╨æK╨ÿ 09050000 MH R3,=H'30' ╨úMHO╨û╨ÿT╨¼ HA ╨ö╨¢╨ÿH╨ú COO╨æ╨⌐EH╨ÿ╨» 09060000 L R6,ERRTBL#A ╨ƒO╨¢╨ú╨º╨ÿT╨¼ A╨öPEC COO╨æ╨⌐EH╨ÿ╨Ö 09070000 LA R3,0(R3,R6) ╨ƒO╨¢╨ú╨º╨ÿT╨¼ A╨öPEC COO╨æ╨⌐EH╨ÿ╨» 09080000 WRTEXT 0(R3),30 B╨½╨öAT╨¼ COO╨æ╨⌐EH╨ÿE 09090000 XR R14,R14 RC = 0 09100000 RETURN 09110000 *********************************************************************** 09120000 LTORG 09130000 DROP BASE 09140000 *********************************************************************** 09150000 * O╨æPA╨æOTKA KOMAH╨ö╨½ S H O W * 09160000 *********************************************************************** 09170000 * RETURN CODE = 0 - OK * 09180000 * RETURN CODE = 2 - ILLEGAL SHOW COMMAND * 09190000 *********************************************************************** 09200000 SHOW SAVE 09210000 USING SHOW,BASE 09220000 LR BASE,R14 09230000 L R6,A#TRT#SO A╨öPEC TA╨æ╨¢╨ÿ╨ª╨½ TRT ASCII EBCDIC 09240000 CLC 0(3,R2),=C'PAR' SHOW PARM ? 09250000 BNE SHO#200 EC╨¢╨ÿ HET, ╨ƒPOBEP╨ÿT╨¼ TRT 09260000 * 09270004 MVC PACKAGE(27),SHOWFIL FILE TEXT OR BINARY 09280004 TM PGMSTAT,X'40' ------------------------------- 09290004 BZ SHO#010 09300000 MVC PACKAGE+21(6),=C'TEXT ' 09310000 SHO#010 CALL WRITMS 09320000 MVC PACKAGE(31),SHOWTRX ╨ÿM╨» TA╨æ╨¢╨ÿ╨ª╨½ TRT 09330004 MVC PACKAGE+29(1),TRTNAME+7 -------------------- 09340004 CALL WRITMS 09350000 MVC PACKAGE(21),SHOWQUO ╨ƒPE╨ñ╨ÿKC QUOTE 09360004 MVC PACKAGE+20(1),QUOTE ---------------------- 09370004 TR PACKAGE+20(1),0(R6) 09380000 CALL WRITMS 09390000 MVC PACKAGE(21),SHOWPRE ╨ƒPE╨ñ╨ÿKC PREF 09400004 MVC PACKAGE+20(1),PREF --------------------- 09410004 TR PACKAGE+20(1),0(R6) 09420000 CALL WRITMS 09430000 MVC PACKAGE(31),SHOWPAC ╨ö╨¢╨ÿHA ╨ƒAKETOB PACKET 09440004 LH R1,PACKET ----------------------- 09450004 BINCVRT R1,PACKAGE+15,DBLWRK 09460000 CALL WRITMS 09470000 MVC PACKAGE(29),SHOWDEL ╨ùA╨öEP╨ûKA SEND DELAY 09480004 LH R1,DELAY ---------------------- 09490004 BINCVRT R1,PACKAGE+15,DBLWRK 09500000 CALL WRITMS 09510000 MVC PACKAGE(15),SHOWRET ╨º╨ÿC╨¢O ╨ƒOBTOPOB RETRY 09520004 LH R1,RETRY ---------------------- 09530004 BINCVRT R1,PACKAGE+9,DBLWRK 09540000 CALL WRITMS 09550000 MVC PACKAGE(37),SHOWREC ╨ö╨¢╨ÿHA INTRA RECORD 09560004 LH R1,I#REC ----------------------- 09570004 SH R1,=H'4' - L'RDW 09580000 BINCVRT R1,PACKAGE+25,DBLWRK 09590000 CALL WRITMS 09600000 MVC PACKAGE(14),SHOWAPP PE╨û╨ÿM APPEND 09610004 TM FILSTAT,X'10' ----------------------- 09620004 BZ SHO#020 09630000 MVC PACKAGE+11(3),=C'ON ' 09640000 SHO#020 CALL WRITMS 09650000 MVC PACKAGE(13),SHOWDEB PE╨û╨ÿM DEBUG 09660004 TM PRMSTAT,X'0C' ---------------------- 09670004 BZ SHO#030 09680000 MVC PACKAGE+10(3),=C'ON ' 09690000 SHO#030 CALL WRITMS 09700000 XR R14,R14 RC = 0 09710000 B SHORET 09720000 * 09730000 SHO#200 EQU * 09740000 CLC 0(3,R2),=C'DES' SHOW DEST ? 09750000 BNE SHO#400 HET 09760000 MVC FILEDEST(4),0(R3) ╨ùA╨ƒ╨ÿCAT╨¼ ╨ÿM╨» ╨ƒ.H. 09770000 LA R1,=C'F' TEST FILE 09780000 CALL TSTDEST 09790000 BRTORC SHO#210,SHO#330,REST=SHO#360 09800000 SHO#210 MVC PACKAGE+1(13),=C'DESTINATION: ' 09810000 MVC PACKAGE+14(4),FILEDEST 09820000 XR R14,R14 09830000 LA R14,17 09840000 STC R14,PACKAGE ╨ö╨¢╨ÿHA COO╨æ╨⌐EH╨ÿ╨» 09850000 CALL WRITMS B╨½BO╨ö 09860000 XR R14,R14 09870000 MVC PACKAGE+1(7),=C'STATE: ' 09880000 TM FILSTAT,X'C0' INTRA ? 09890000 BNO SHO#220 HET 09900000 MVC PACKAGE+8(10),=C'INTRA ' 09910000 LA R14,17 09920000 STC R14,PACKAGE ╨ö╨¢╨ÿHA COO╨æ╨⌐EH╨ÿ╨» 09930000 CALL WRITMS B╨½BO╨ö 09940000 B SHO#300 RETURN 09950000 * 09960000 SHO#220 TM FILSTAT,X'01' OPEN ? 09970000 BO SHO#230 ╨öA 09980000 MVC PACKAGE+8(12),=C'EXTRA CLOSE' 09990000 LA R14,19 10000000 STC R14,PACKAGE 10010000 CALL WRITMS 10020000 B SHO#300 10030000 * 10040000 SHO#230 MVC PACKAGE+8(13),=C'EXTRA OPEN ' 10050000 TM FILSTAT,X'20' INPUT ? 10060000 BO SHO#240 ╨öA 10070000 MVC PACKAGE+21(6),=C'OUTPUT' 10080000 B SHO#250 10090000 SHO#240 MVC PACKAGE+21(6),=C'INPUT ' 10100000 SHO#250 LA R14,26 10110000 STC R14,PACKAGE ╨ö╨¢╨ÿHA COO╨æ╨⌐EH╨ÿ╨» 10120000 CALL WRITMS B╨½BO╨ö 10130000 MVC PACKAGE+1(8),=C'FORMAT: ' 10140000 TM FILSTAT,X'0C' 10150000 BO SHO#260 FORMAT U 10160000 TM FILSTAT,X'08' 10170000 BO SHO#270 FORMAT F 10180000 MVC PACKAGE+9(31),=C'V RECORD LENGHT = ' 10190000 B SHO#280 10200000 SHO#260 MVC PACKAGE+9(31),=C'U RECORD LENGHT = ' 10210000 B SHO#280 10220000 SHO#270 MVC PACKAGE+9(31),=C'F RECORD LENGHT = ' 10230000 SHO#280 LH R14,F#REC 10240000 BINCVRT R14,PACKAGE+30,DBLWRK 10250000 XR R14,R14 10260000 LA R14,39 10270000 STC R14,PACKAGE ╨ö╨¢╨ÿHA COO╨æ╨⌐EH╨ÿ╨» 10280000 CALL WRITMS B╨½BO╨ö 10290000 SHO#300 XR R14,R14 10300000 ST R14,FILEDEST ╨ùATEPET╨¼ ╨ÿM╨» ╨ƒ.H. 10310000 B SHORET 10320000 * 10330000 SHO#330 MVC PACKAGE+1(13),=C'DESTINATION: ' 10340000 MVC PACKAGE+14(4),FILEDEST 10350000 XR R14,R14 10360000 LA R14,17 10370000 STC R14,PACKAGE ╨ö╨¢╨ÿHA COO╨æ╨⌐EH╨ÿ╨» 10380000 CALL WRITMS B╨½BO╨ö 10390000 XR R14,R14 10400000 WRMESS 'IS NOT DEFINED.' 10410000 B SHO#300 10420000 * 10430000 SHO#360 MVC PACKAGE+1(23),=C'TSTDEST ERROR: ' 10440000 BINCVRT R14,PACKAGE+15,DBLWRK 10450000 LA R14,23 10460000 STC R14,PACKAGE 10470000 CALL WRITMS 10480000 B SHO#300 10490000 * 10500000 SHO#400 CLC 0(3,R2),=C'TRT' SHOW TRT ? 10510000 BE SHO#410 ╨öA 10520000 LA R14,2 RC = 2 10530000 B SHORET 10540000 SHO#410 WRMESS 'OUTPUT DISK TRANSLATE TABLE IS:' 10550000 L R1,A#TRT#AE 10560000 BAL R2,SHO#600 B╨½BECT╨ÿ BXO╨öH╨ú╨« TA╨æ╨¢╨ÿ╨ª╨ú 10570000 WRMESS 'TYPE <CR>' 10580000 CALL RDTRM 10590000 WRMESS 'INPUT DISK TRANSLATE TABLE IS:' 10600000 L R1,A#TRT#EA 10610000 BAL R2,SHO#600 B╨½BECT╨ÿ B╨½XO╨öH╨ú╨« TA╨æ╨¢╨ÿ╨ª╨ú 10620000 XR R14,R14 RC = 0 10630000 B SHORET 10640000 * 10650000 SHO#600 LA R3,16 C╨ºET╨º╨ÿK CTPOK 10660000 SHO#620 LA R5,16 C╨ºET╨º╨ÿK C╨ÿMBO╨¢OB B CTPOKE 10670000 SR R14,R14 ╨ö╨¢╨» ╨ƒPEO╨æPA╨ùOBAH╨ÿ╨» ╨öAHH╨½X 10680000 MVI PACKAGE,32 ╨ö╨¢╨ÿHA ╨öAHH╨½X 10690000 LA R4,PACKAGE+1 A╨öPEC ╨ƒEPBO╨ôO ╨æA╨ÖTA B╨½X. ╨ƒO╨¢╨» 10700000 SHO#640 IC R14,0(,R1) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ O╨ºEPE╨öHO╨Ö ╨æA╨ÖT 10710000 STC R14,1(,R4) ╨ùA╨ƒ╨ÿCAT╨¼ BTOP╨ú╨« TETPA╨ö╨ú 10720000 NI 1(R4),X'0F' C╨æPOC╨ÿT╨¼ CTAP╨¿╨ú╨« TETPA╨ö╨ú 10730000 SRL R14,4 ╨ú╨öA╨¢╨ÿT╨¼ M╨¢A╨ö╨¿╨ú╨« TETPA╨ö╨ú 10740000 STC R14,0(,R4) ╨ùA╨ƒ╨ÿCAT╨¼ CTAP╨¿╨ú╨« ╨ƒO╨¢OB╨ÿH╨ú 10750000 TR 0(2,R4),TRBYTE ╨ƒEPEBECT╨ÿ B C╨ÿMBO╨¢╨¼H╨½╨Ö B╨ÿ╨ö 10760000 LA R1,1(,R1) ╨ƒEPEMECT╨ÿT╨¼ BXO╨öHO╨Ö ╨úKA╨ùATE╨¢╨¼ 10770000 LA R4,2(,R4) ╨ƒEPEMECT╨ÿT╨¼ B╨½XO╨öHO╨Ö ╨úKA╨ùATE╨¢╨¼ 10780000 BCT R5,SHO#640 ╨ÿ ╨öAM╨ƒ╨ÿPOBAT╨¼ C╨¢E╨ö. ╨æA╨ÖT 10790000 * CTPOKA ╨ùA╨ƒO╨¢HEHA 10800000 CALL WRITMS 10810000 BCT R3,SHO#620 ╨öAM╨ƒ╨ÿPOBAT╨¼ C╨¢E╨ö╨ú╨«╨⌐╨ú╨« CTPOK╨ú 10820000 BR R2 BO╨ùBPAT 10830000 * 10840000 TRBYTE DC C'0123456789ABCDEF' 10850000 SHOWQUO DC AL1(20),C'QUOTE CHARACTER IS .' 10860000 SHOWPRE DC AL1(20),C'PREF CHARACTER IS .' 10870000 SHOWPAC DC AL1(30),C'PACKET SIZE IS ..... (DECIMAL)' 10880000 SHOWDEL DC AL1(28),C'DELAY VALUE IS ..... SECONDS' 10890000 SHOWDEB DC AL1(12),C'DEBUG IS OFF' 10900000 SHOWFIL DC AL1(26),C'FILE TYPE IS SET TO BINARY' 10910000 SHOWTRX DC AL1(30),C'CURRENT TRANSLATE TABLE IS - -' 10920000 SHOWAPP DC AL1(13),C'APPEND IS OFF' 10930000 SHOWREC DC AL1(36),C'INTRA RECORD SIZE SET IS ..... BYTE.' 10940000 SHOWRET DC AL1(14),C'RETRY IS .....' 10950000 * 10960000 SHORET RETURN 10970000 *********************************************************************** 10980000 LTORG 10990000 DROP BASE 11000000 *********************************************************************** 11010000 * ╨ƒO╨ö╨ƒPO╨ôPAMMA O╨æPA╨æOTK╨ÿ KOMAH╨ö╨½ S E T * 11020000 *********************************************************************** 11030000 * RETURN CODE = 0 - OK * 11040000 * RETURN CODE = 2 - ILLEGAL SET COMMAND * 11050000 *********************************************************************** 11060000 SET SAVE 11070000 USING SET,BASE 11080000 LR BASE,R14 ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨æA╨ùOB╨½╨Ö PE╨ô╨ÿCTP 11090000 CLC 0(3,R2),=C'APP' SET APPEND ? 11100000 BNE SET#010 ╨úB╨½.. 11110000 CLI 0(R3),C' ' ECT╨¼ 3-╨ÿ╨Ö O╨ƒEPAH╨ö ? 11120000 BE SETERR ╨úB╨½.. 11130000 CLI 0(R3),C'?' SET APPEND HELP ? 11140000 BE SET#005 ╨öA 11150000 CALL SETAPEND 11160000 B SETOK 11170000 SET#005 WRMESS 'ON ! OFF (ENABLE OR DISABLE APPEND MODE).' 11180000 B SETOK 11190000 SET#010 CLC 0(3,R2),=C'QUO' SET QUOTE ? 11200000 BNE SET#030 ╨úB╨½.. 11210000 CLI 0(R3),C' ' ECT╨¼ 3-╨ÿ╨Ö O╨ƒEPAH╨ö ? 11220000 BE SETERR ╨úB╨½.. 11230000 CLI 0(R3),C'?' SET QUOTE HELP ? 11240000 BE SET#020 ╨öA 11250000 CALL SETQUOTE 11260000 B SETOK 11270000 SET#020 WRMESS 'A SINGLE CHARACTER.' 11280000 B SETOK 11290000 SET#030 CLC 0(3,R2),=C'PAC' SET PACKET-SIZE ? 11300000 BNE SET#050 ╨úB╨½.. 11310000 CLI 0(R3),C' ' ECT╨¼ O╨ƒEPAH╨ö ? 11320000 BE SETERR ╨úB╨½.. 11330000 CLI 0(R3),C'?' SET PAC HELP ? 11340000 BE SET#040 ╨öA 11350000 CALL SETPACK 11360000 B SETOK 11370000 SET#040 WRMESS 'PACKET-SIZE (RANGE: 26-94 DECIMAL).' 11380000 B SETOK 11390000 SET#050 CLC 0(3,R2),=C'DEL' SET DELAY ? 11400000 BNE SET#070 ╨úB╨½.. 11410000 CLI 0(R3),C' ' ECT╨¼ O╨ƒEPAH╨ö ? 11420000 BE SETERR ╨úB╨½.. 11430000 CLI 0(R3),C'?' SET DELAY HELP ? 11440000 BE SET#060 ╨öA 11450000 CALL SETDELAY 11460000 B SETOK 11470000 SET#060 WRMESS 'DELAY INTERVAL BEFORE SENDING A FILE.' 11480000 B SETOK 11490000 SET#070 CLC 0(3,R2),=C'DEB' DEBUG ? 11500000 BNE SET#090 ╨úB╨½.. 11510000 CLI 0(R3),C' ' ECT╨¼ O╨ƒEPAH╨ö ? 11520000 BE SETERR ╨úB╨½.. 11530000 CLI 0(R3),C'?' SET DEBUG HELP ? 11540000 BE SET#080 ╨öA 11550000 CALL SETDEBUG 11560000 B SETOK 11570000 SET#080 WRMESS 'ON ! OFF (ENABLE OR DISABLE DEBUG MODE).' 11580000 B SETOK 11590000 SET#090 CLC 0(3,R2),=C'TRT' SET TRT ? 11600000 BNE SET#120 ╨úB╨½.. 11610000 CLI 0(R3),C' ' ECT╨¼ O╨ƒEPAH╨ö ? 11620000 BE SETERR ╨úB╨½.. 11630000 CLI 0(R3),C'?' ╨ùA╨ƒPO╨¿EH HELP ? 11640000 BE SET#100 ╨öA 11650000 CALL SETTRT 11660000 BRTORC SETOK,REST=SET#110 11670000 SET#100 WRMESS 'A SINGLE CHARACTER.' 11680000 WRMESS 'S (STANDARD) ! X (TR TABLE SUFFIX).' 11690000 B SETOK 11700000 SET#110 WRMESS 'TRANSLATE TABLE IS NOT DEFINED.' 11710000 B SETOK 11720000 SET#120 CLC 0(3,R2),=C'FIL' SET FILE ? 11730000 BNE SET#150 ╨úB╨½.. 11740000 CLI 0(R3),C' ' ECT╨¼ O╨ƒEPAH╨ö ? 11750000 BE SETERR ╨úB╨½.. 11760000 CLI 0(R3),C'?' SET FILE HELP ? 11770000 BE SET#130 ╨öA 11780000 CALL SETFILE 11790000 BRTORC SETOK,REST=SET#140 11800000 SET#130 WRMESS 'TEXT ! BINARY.' 11810000 B SETOK 11820000 SET#140 WRMESS 'COMMAND IS SET FILE TEXT ! BINARY' 11830000 B SETOK 11840000 SET#150 CLC 0(3,R2),=C'PRE' SET PREF ? 11850000 BNE SET#170 ╨úB╨½.. 11860000 CLI 0(R3),C' ' ECT╨¼ 3-╨ÿ╨Ö O╨ƒEPAH╨ö ? 11870000 BE SETERR ╨úB╨½.. 11880000 CLI 0(R3),C'?' SET PREF HELP ? 11890000 BE SET#160 ╨öA 11900000 CALL SETPREF 11910000 B SETOK 11920000 SET#160 WRMESS 'A SINGLE CHARACTER.' 11930000 B SETOK 11940000 SET#170 CLC 0(3,R2),=C'REC' SET RECORD ? 11950000 BNE SET#190 ╨úB╨½.. 11960000 CLI 0(R3),C' ' ECT╨¼ 3-╨ÿ╨Ö O╨ƒEPAH╨ö ? 11970000 BE SETERR ╨úB╨½.. 11980000 CLI 0(R3),C'?' SET RECORD HELP ? 11990000 BE SET#180 ╨öA 12000000 CALL SETRECRD 12010000 B SETOK 12020000 SET#180 WRMESS 'RECORD-LENGHT FOR INTRA DESTINATION.' 12030000 WRMESS '(RANGE: 80-4096. SET IS 4096.)' 12040000 B SETOK 12050000 SET#190 CLC 0(3,R2),=C'PRO' SET PROMPT ? 12060000 BNE SET#210 ╨úB╨½.. 12070002 CLI 0(R3),C' ' ECT╨¼ 3-╨ÿ╨Ö O╨ƒEPAH╨ö ? 12080000 BE SETERR ╨úB╨½.. 12090000 CLI 0(R3),C'?' SET PROMPT HELP ? 12100000 BE SET#200 ╨öA 12110000 CALL SETPRMPT 12120000 B SETOK 12130000 SET#200 WRMESS 'PROMPT STRING. (LENGHT 1-22).' 12140000 B SETOK 12150000 SET#210 CLC 0(3,R2),=C'RET' SET RETRY ? 12160002 BNE SETERROR ╨úB╨½.. 12170002 CLI 0(R3),C' ' ECT╨¼ O╨ƒEPAH╨ö ? 12180002 BE SETERR ╨úB╨½.. 12190002 CLI 0(R3),C'?' SET RET HELP ? 12200002 BE SET#220 ╨öA 12210002 CALL SETRETRY 12220002 B SETOK 12230002 SET#220 WRMESS 'PACKET RETRY. (RANGE: 1-63 DECIMAL).' 12240002 B SETOK 12250002 * 12260000 SETERR WRMESS '? NOT CONFIRMED' 12270000 SETOK XR R14,R14 RC = 0 12280000 B SETRET 12290000 SETERROR LA R14,2 RC = 2 12300000 SETRET RETURN 12310000 *********************************************************************** 12320000 LTORG 12330000 DROP BASE 12340000 *********************************************************************** 12350000 * SET RECORD * 12360000 *********************************************************************** 12370000 * RETURN CODE = 0 - OK * 12380000 * RETURN CODE = 2 - ILLEGAL SET COMMAND * 12390000 *********************************************************************** 12400000 SETRECRD SAVE 12410000 USING SETRECRD,BASE 12420000 LR BASE,R14 12430000 XC DBLWRK,DBLWRK O╨º╨ÿCT╨ÿT╨¼ PA╨æO╨º╨ú╨« O╨æ╨¢ACT╨¼ 12440000 LR R2,R3 CKO╨ƒ╨ÿPOBAT╨¼ A╨öPEC HA╨ºA╨¢A O╨ƒEPAH╨öA 12450000 LA R1,4 MAKC╨ÿMA╨¢╨¼HA╨» ╨ö╨¢╨ÿHA O╨ƒEPAH╨öA 12460000 SETRECLP CLI 0(R2),C'0' ╨öO╨¢╨ûHA ╨æ╨½T╨¼ ╨ª╨ÿ╨ñPA 12470000 BL SETREC01 ╨ª╨ÿ╨ñP MEH╨¼╨¿E 0 HE ╨æ╨½BAET 12480000 CLI 0(R2),C'9' 12490000 BH SETREC01 TAK ╨ûE KAK ╨ÿ ╨æO╨¢╨¼╨¿E 9 12500000 CLI 1(R2),C' ' KOHE╨ª O╨ƒEPAH╨öA ? 12510000 BE SETREC02 EC╨¢╨ÿ ╨öA, B╨½XO╨ö ╨ÿ╨ù ╨ª╨ÿK╨¢A 12520000 LA R2,1(R2) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ 12530000 BCT R1,SETRECLP ╨ÿ ╨ƒPOBEP╨»T╨¼ C╨¢E╨ö╨ú╨«╨⌐╨ÿ╨Ö C╨ÿMBO╨¢ 12540000 SETREC01 WRMESS 'MUST BE BETWEEN 80-4092' 12550000 LA R14,2 RC = 2 12560000 B SETRECR 12570000 PCKREC PACK DBLWRK(8),0(0,R3) 12580000 SETREC02 SR R2,R3 ╨ƒO╨¢╨ú╨º╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú O╨ƒEPAH╨öA - 1 12590000 EX R2,PCKREC ╨ú╨ƒAKOBAT╨¼ 12600000 CVB R2,DBLWRK 12610000 CH R2,=H'80' EC╨¢╨ÿ MEH╨¼╨¿E, OTBEP╨ôH╨úT╨¼ 12620000 BL SETREC01 12630000 CH R2,=H'4092' 12640000 BH SETREC01 EC╨¢╨ÿ ╨æO╨¢╨¼╨¿E, OTBEP╨ôH╨úT╨¼ 12650000 LA R2,4(R2) + RDW 12660000 STH R2,I#REC 12670000 XR R14,R14 RC = 0 12680000 SETRECR RETURN 12690000 *********************************************************************** 12700000 LTORG 12710000 DROP BASE 12720000 *********************************************************************** 12730000 * SET PROMPT * 12740000 *********************************************************************** 12750000 * RETURN CODE = 0 - OK * 12760000 * RETURN CODE = 2 - ILLEGAL SET COMMAND * 12770000 *********************************************************************** 12780000 SETPRMPT SAVE 12790000 USING SETPRMPT,BASE 12800000 LR BASE,R14 12810000 LR R2,R3 CKO╨ƒ╨ÿPOBAT╨¼ A╨öPEC HA╨ºA╨¢A O╨ƒEPAH╨öA 12820000 LA R1,22 MAKC╨ÿMA╨¢╨¼HA╨» ╨ö╨¢╨ÿHA O╨ƒEPAH╨öA 12830000 SETPRMP1 EQU * 12840000 CLI 1(R2),C' ' KOHE╨ª O╨ƒEPAH╨öA ? 12850000 BE SETPRMP3 EC╨¢╨ÿ ╨öA, B╨½XO╨ö ╨ÿ╨ù ╨ª╨ÿK╨¢A 12860000 LA R2,1(R2) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ 12870000 BCT R1,SETPRMP1 ╨ÿ ╨ƒPOBEP╨»T╨¼ C╨¢E╨ö╨ú╨«╨⌐╨ÿ╨Ö C╨ÿMBO╨¢ 12880000 SETPRMP2 WRMESS 'LENGHT MUST BE BETWEEN 1-22.' 12890000 LA R14,2 RC = 2 12900000 B SETPRMPR 12910000 PRMPT#99 MVC 1(0,R15),0(R3) 12920000 SETPRMP3 SR R2,R3 ╨ƒO╨¢╨ú╨º╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú O╨ƒEPAH╨öA - 1 12930000 LA R15,PROMPT 12940000 EX R2,PRMPT#99 ╨ƒEPEC╨¢AT╨¼ 12950000 LA R2,2(R2) ╨ö╨¢╨ÿHA + 1 (SPACE) 12960000 STC R2,0(R15) 12970000 AR R15,R2 12980000 MVI 0(R15),C' ' 12990000 XR R14,R14 RC = 0 13000000 SETPRMPR RETURN 13010000 *********************************************************************** 13020000 LTORG 13030000 DROP BASE 13040000 *********************************************************************** 13050000 * SET QUOTE * 13060000 *********************************************************************** 13070000 * RETURN CODE = 0 - OK * 13080000 * RETURN CODE = 2 - ILLEGAL SET COMMAND * 13090000 *********************************************************************** 13100000 SETQUOTE SAVE 13110000 USING SETQUOTE,BASE 13120000 LR BASE,R14 13130000 CLI 1(R3),C' ' O╨ö╨ÿH C╨ÿMBO╨¢ ? 13140000 BE SETQU01 EC╨¢╨ÿ ╨öA, ╨ƒPOBEP╨»T╨¼ QUOTE 13150000 WRMESS 'ONE CHARACTER ONLY' 13160000 LA R14,2 RC = 2 13170000 B SETQR 13180000 SETQU01 EQU * 13190000 L R6,A#TRT#SI A╨öPEC TA╨æ╨¢╨ÿ╨ª╨½ TRT EBCDIC -> ASCII 13200000 TR 0(1,R3),0(R6) ╨ƒEPEBECT╨ÿ B ASCII 13210000 CLI 0(R3),X'21' HE MO╨ûET ╨æ╨½T╨¼ MEH╨¼╨¿E 32 13220000 BL SETQE EC╨¢╨ÿ MEH╨¼╨¿E, TO O╨¿╨ÿ╨æKA 13230000 CLI 0(R3),X'7E' HE MO╨ûET ╨æ╨½T╨¼ ╨æO╨¢╨¼╨¿E 126 13240000 BH SETQE EC╨¢╨ÿ ╨æO╨¢╨¼╨¿E, TO O╨¿╨ÿ╨æKA 13250000 CLI 0(R3),X'3E' ╨öO╨¢╨ûEH ╨æ╨½T╨¼ B ╨ÿHTEPBA╨¢E 32-62 13260000 BNH SETQO 13270000 CLI 0(R3),X'60' ╨ÿ╨¢╨ÿ B ╨ÿHTEPBA╨¢E 96-126 13280000 BNL SETQO EC╨¢╨ÿ HE MEH╨¼╨¿E, OK 13290000 SETQE WRMESS 'MUST FALL BETWEEN 41-76, 140 OR 173-176 (OCTAL)' 13300000 LA R14,2 RC = 2 13310000 B SETQR 13320000 SETQO MVC QUOTE(1),0(R3) ╨ùA╨ƒ╨ÿCAT╨¼ C╨ÿMBO╨¢ 13330000 XR R14,R14 RC = 0 13340000 SETQR RETURN 13350000 *********************************************************************** 13360000 LTORG 13370000 DROP BASE 13380000 *********************************************************************** 13390000 * SET PREF * 13400000 *********************************************************************** 13410000 * RETURN CODE = 0 - OK * 13420000 * RETURN CODE = 2 - ILLEGAL SET COMMAND * 13430000 *********************************************************************** 13440000 SETPREF SAVE 13450000 USING SETPREF,BASE 13460000 LR BASE,R14 13470000 CLI 1(R3),C' ' O╨ö╨ÿH C╨ÿMBO╨¢ ? 13480000 BE SETPR01 EC╨¢╨ÿ ╨öA, ╨ƒPOBEP╨»T╨¼ PREF 13490000 WRMESS 'ONE CHARACTER ONLY' 13500000 LA R14,2 RC = 2 13510000 B SETPRRET 13520000 SETPR01 EQU * 13530000 L R6,A#TRT#SI A╨öPEC TA╨æ╨¢╨ÿ╨ª╨½ TRT EBCDIC -> ASCII 13540000 TR 0(1,R3),0(R6) ╨ƒEPEBECT╨ÿ B ASCII 13550000 CLI 0(R3),X'21' HE MO╨ûET ╨æ╨½T╨¼ MEH╨¼╨¿E 32 13560000 BL SETPRER EC╨¢╨ÿ MEH╨¼╨¿E, TO O╨¿╨ÿ╨æKA 13570000 CLI 0(R3),X'7E' HE MO╨ûET ╨æ╨½T╨¼ ╨æO╨¢╨¼╨¿E 126 13580000 BH SETPRER EC╨¢╨ÿ ╨æO╨¢╨¼╨¿E, TO O╨¿╨ÿ╨æKA 13590000 CLI 0(R3),X'3E' ╨öO╨¢╨ûEH ╨æ╨½T╨¼ B ╨ÿHTEPBA╨¢E 32-62 13600000 BNH SETPROK 13610000 CLI 0(R3),X'60' ╨ÿ╨¢╨ÿ B ╨ÿHTEPBA╨¢E 96-126 13620000 BNL SETPROK EC╨¢╨ÿ HE MEH╨¼╨¿E, OK 13630000 SETPRER WRMESS 'MUST FALL BETWEEN 41-76, 140 OR 173-176 (OCTAL)' 13640000 LA R14,2 RC = 2 13650000 B SETPRRET 13660000 SETPROK MVC PREF(1),0(R3) ╨ùA╨ƒ╨ÿCAT╨¼ C╨ÿMBO╨¢ 13670000 XR R14,R14 RC = 0 13680000 SETPRRET RETURN 13690000 *********************************************************************** 13700000 LTORG 13710000 DROP BASE 13720000 *********************************************************************** 13730000 * SET PACKET-SIZE * 13740000 *********************************************************************** 13750000 * RETURN CODE = 0 - OK * 13760000 * RETURN CODE = 2 - ILLEGAL SET COMMAND * 13770000 *********************************************************************** 13780000 SETPACK SAVE 13790000 USING SETPACK,BASE 13800000 LR BASE,R14 13810000 CLI 0(R3),C'0' ╨öO╨¢╨ûEH ╨æ╨½T╨¼ >= 0 13820000 BL SETKE EC╨¢╨ÿ MEH╨¼╨¿E, O╨¿╨ÿ╨æKA 13830000 CLI 0(R3),C'9' ╨öO╨¢╨ûEH ╨æ╨½T╨¼ <= 9 13840000 BH SETKE EC╨¢╨ÿ ╨æO╨¢╨¼╨¿E, TO TO╨ûE O╨¿╨ÿ╨æKA 13850000 XC DBLWRK,DBLWRK O╨º╨ÿCT╨ÿT╨¼ PA╨æO╨º╨ú╨« O╨æ╨¢ACT╨¼ 13860000 CLI 1(R3),C' ' HE ╨öO╨¢╨ûEH ╨æ╨½T╨¼ KOHE╨ª 13870000 BE SETKE EC╨¢╨ÿ 1 ╨ª╨ÿ╨ñPA, TO ╨¡TO O╨¿╨ÿ╨æKA 13880000 CLI 2(R3),C' ' A ╨ù╨öEC╨¼ ╨öO╨¢╨ûEH ╨æ╨½T╨¼ KOHE╨ª O╨ƒEPAH╨öA 13890000 BNE SETKE EC╨¢╨ÿ HE KOHE╨ª, TO ╨¡TO O╨¿╨ÿ╨æKA 13900000 PACK DBLWRK(8),0(2,R3) ╨ú╨ƒAKOBAT╨¼ O╨ƒEPAH╨ö 13910000 CVB R14,DBLWRK ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ PA╨ùMEP ╨ƒAKETA 13920000 CH R14,=H'26' M╨ÿH╨ÿMA╨¢╨¼HOE ╨ùHA╨ºEH╨ÿE ╨ö╨¢╨ÿH╨½ 13930000 BL SETKE EC╨¢╨ÿ MEH╨¼╨¿E, OTBEP╨ôH╨úT╨¼ 13940000 CH R14,=H'94' MAKC╨ÿMA╨¢╨¼HA╨» ╨ö╨¢╨ÿHA ╨ƒAKETA 13950000 BH SETKE EC╨¢╨ÿ ╨æO╨¢╨¼╨¿E MAKC╨ÿM╨úMA, TO HE ╨ôO╨ö╨ÿTC╨» 13960000 STH R14,PACKET ╨ùA╨ƒ╨ÿCAT╨¼ ╨ƒAPAMETP B TWA 13970000 XR R14,R14 RC = 0 13980000 B SETKR 13990000 SETKE WRMESS 'MUST BE BETWEEN 26-94 (DECIMAL)' 14000000 LA R14,2 RC = 2 14010000 SETKR RETURN 14020000 *********************************************************************** 14030000 LTORG 14040000 DROP BASE 14050000 *********************************************************************** 14060000 * SET DELAY * 14070000 *********************************************************************** 14080000 * RETURN CODE = 0 - OK * 14090000 * RETURN CODE = 2 - ILLEGAL SET COMMAND * 14100000 *********************************************************************** 14110000 SETDELAY SAVE 14120000 USING SETDELAY,BASE 14130000 LR BASE,R14 14140000 XC DBLWRK,DBLWRK O╨º╨ÿCT╨ÿT╨¼ PA╨æO╨º╨ú╨« O╨æ╨¢ACT╨¼ 14150000 LR R2,R3 CKO╨ƒ╨ÿPOBAT╨¼ A╨öPEC HA╨ºA╨¢A O╨ƒEPAH╨öA 14160000 LA R1,5 MAKC╨ÿMA╨¢╨¼HA╨» ╨ö╨¢╨ÿHA O╨ƒEPAH╨öA 14170000 SETDLOOP CLI 0(R2),C'0' ╨öO╨¢╨ûHA ╨æ╨½T╨¼ ╨ª╨ÿ╨ñPA 14180000 BL SETDE ╨ª╨ÿ╨ñP MEH╨¼╨¿E 0 HE ╨æ╨½BAET 14190000 CLI 0(R2),C'9' 14200000 BH SETDE TAK ╨ûE KAK ╨ÿ ╨æO╨¢╨¼╨¿E 9 14210000 CLI 1(R2),C' ' KOHE╨ª O╨ƒEPAH╨öA ? 14220000 BE SETD1 EC╨¢╨ÿ ╨öA, B╨½XO╨ö ╨ÿ╨ù ╨ª╨ÿK╨¢A 14230000 LA R2,1(R2) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ 14240000 BCT R1,SETDLOOP ╨ÿ ╨ƒPOBEP╨»T╨¼ C╨¢E╨ö╨ú╨«╨⌐╨ÿ╨Ö C╨ÿMBO╨¢ 14250000 SETDE WRMESS 'MUST BE BETWEEN 1-32767' 14260000 LA R14,2 RC = 2 14270000 B SETDR 14280000 PCK PACK DBLWRK(8),0(0,R3) 14290000 SETD1 SR R2,R3 ╨ƒO╨¢╨ú╨º╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú O╨ƒEPAH╨öA - 1 14300000 EX R2,PCK ╨ú╨ƒAKOBAT╨¼ 14310000 CVB R2,DBLWRK ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ùHA╨ºEH╨ÿE ╨ùA╨öEP╨ûK╨ÿ 14320000 LTR R2,R2 EC╨¢╨ÿ HO╨¢╨¼, TO HE ╨ôO╨ö╨ÿTC╨» 14330000 BNP SETDE 14340000 CH R2,=H'32767' MAKC╨ÿMA╨¢╨¼HA╨» BE╨¢╨ÿ╨º╨ÿHA ╨ùA╨öEP╨ûK╨ÿ 14350000 BH SETDE EC╨¢╨ÿ ╨æO╨¢╨¼╨¿E, OTBEP╨ôH╨úT╨¼ 14360000 STH R2,DELAY ╨ùA╨ƒ╨ÿCAT╨¼ ╨ùA╨öEP╨ûK╨ú B TWA 14370000 XR R14,R14 RC = 0 14380000 SETDR RETURN 14390000 *********************************************************************** 14400000 LTORG 14410000 DROP BASE 14420000 *********************************************************************** 14430002 * SET RETRY * 14440002 *********************************************************************** 14450002 * RETURN CODE = 0 - OK * 14460002 * RETURN CODE = 2 - ILLEGAL SET COMMAND * 14470002 *********************************************************************** 14480002 SETRETRY SAVE 14490002 USING SETRETRY,BASE 14500002 LR BASE,R14 14510002 XC DBLWRK,DBLWRK O╨º╨ÿCT╨ÿT╨¼ PA╨æO╨º╨ú╨« O╨æ╨¢ACT╨¼ 14520002 LR R2,R3 CKO╨ƒ╨ÿPOBAT╨¼ A╨öPEC HA╨ºA╨¢A O╨ƒEPAH╨öA 14530002 LA R1,2 MAKC╨ÿMA╨¢╨¼HA╨» ╨ö╨¢╨ÿHA O╨ƒEPAH╨öA 14540002 SETRLOOP CLI 0(R2),C'0' ╨öO╨¢╨ûHA ╨æ╨½T╨¼ ╨ª╨ÿ╨ñPA 14550002 BL SETRE ╨ª╨ÿ╨ñP MEH╨¼╨¿E 0 HE ╨æ╨½BAET 14560002 CLI 0(R2),C'9' 14570002 BH SETRE TAK ╨ûE KAK ╨ÿ ╨æO╨¢╨¼╨¿E 9 14580002 CLI 1(R2),C' ' KOHE╨ª O╨ƒEPAH╨öA ? 14590002 BE SETR1 EC╨¢╨ÿ ╨öA, B╨½XO╨ö ╨ÿ╨ù ╨ª╨ÿK╨¢A 14600002 LA R2,1(R2) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ 14610002 BCT R1,SETRLOOP ╨ÿ ╨ƒPOBEP╨»T╨¼ C╨¢E╨ö╨ú╨«╨⌐╨ÿ╨Ö C╨ÿMBO╨¢ 14620002 SETRE WRMESS 'MUST BE BETWEEN 1-63' 14630002 LA R14,2 RC = 2 14640002 B SETRR 14650002 RETRYPK PACK DBLWRK(8),0(0,R3) 14660002 SETR1 SR R2,R3 ╨ƒO╨¢╨ú╨º╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú O╨ƒEPAH╨öA - 1 14670002 EX R2,RETRYPK ╨ú╨ƒAKOBAT╨¼ 14680002 CVB R2,DBLWRK ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ùHA╨ºEH╨ÿE RETRY 14690002 LTR R2,R2 EC╨¢╨ÿ HO╨¢╨¼, TO HE ╨ôO╨ö╨ÿTC╨» 14700002 BNP SETRE 14710002 CH R2,=H'63' MAKC╨ÿMA╨¢╨¼HA╨» BE╨¢╨ÿ╨º╨ÿHA RETRY 14720002 BH SETRE EC╨¢╨ÿ ╨æO╨¢╨¼╨¿E, OTBEP╨ôH╨úT╨¼ 14730002 STH R2,RETRY ╨ùA╨ƒ╨ÿCAT╨¼ RETRY B TWA 14740002 XR R14,R14 RC = 0 14750002 SETRR RETURN 14760002 *********************************************************************** 14770002 LTORG 14780002 DROP BASE 14790002 *********************************************************************** 14800000 * SET APPEND * 14810000 *********************************************************************** 14820000 * RETURN CODE = 0 - OK * 14830000 * RETURN CODE = 2 - ILLEGAL SET COMMAND * 14840000 *********************************************************************** 14850000 SETAPEND SAVE 14860000 USING SETAPEND,BASE 14870000 LR BASE,R14 14880000 CLC 0(2,R3),=C'ON' SET APPEND ON ? 14890000 BE SETAON EC╨¢╨ÿ ╨öA, ╨úCTAHOB╨ÿT╨¼ 14900000 CLC 0(2,R3),=C'OF' SET APPEND OFF ? 14910000 BE SETAOFF EC╨¢╨ÿ ╨öA, CH╨»T╨¼ PE╨û╨ÿM 14920000 WRMESS 'COMMAND IS SET APPEND ON ! OFF' 14930000 LA R14,2 RC = 2 14940000 B SETAPPR 14950000 SETAON OI FILSTAT,X'10' SET APPEND ON 14960000 WRMESS 'APPEND ON.' 14970000 B SETAA 14980000 SETAOFF NI FILSTAT,X'FF'-X'10' SET APPEND OFF 14990000 WRMESS 'APPEND OFF.' 15000000 SETAA XR R14,R14 RC = 0 15010000 SETAPPR RETURN 15020000 *********************************************************************** 15030000 LTORG 15040000 DROP BASE 15050000 *********************************************************************** 15060000 * SET DEBUG * 15070000 *********************************************************************** 15080000 * RETURN CODE = 0 - OK * 15090000 * RETURN CODE = 2 - ILLEGAL SET COMMAND * 15100000 *********************************************************************** 15110000 SETDEBUG SAVE 15120000 USING SETDEBUG,BASE 15130000 LR BASE,R14 15140000 CLC 0(2,R3),=C'ON' SET DEBUG ON ? 15150000 BE SETGON EC╨¢╨ÿ ╨öA, ╨úCTAHOB╨ÿT╨¼ 15160000 CLC 0(2,R3),=C'OF' SET DEBUG OFF ? 15170000 BE SETGOFF EC╨¢╨ÿ ╨öA, CH╨»T╨¼ PE╨û╨ÿM 15180000 WRMESS 'COMMAND IS SET DEBUG ON ! OFF' 15190000 LA R14,2 RC = 2 15200000 B SETGR 15210000 SETGON TM PRMSTAT,X'0C' DEBUG ON ? 15220000 BO SETGA EC╨¢╨ÿ ╨öA, CPA╨ù╨ú B╨½XO╨ö 15230000 LA R1,=C'D' 15240000 CALL TSTDEST 15250000 LTR R14,R14 15260000 BZ SETGEXOK 15270000 WRMESS 'DEBUG OFF.' 15280000 B SETGA 15290000 SETGEXOK UNPK DBLWRK(7),CSATODP(4) 15300000 MVC $TIME(6),DBLWRK ╨ùA╨ƒ╨ÿCAT╨¼ BPEM╨» 15310000 OI PRMSTAT,X'0C' B╨½CTAB╨ÿT╨¼ ╨ƒP╨ÿ╨ùHAK DEBUG ON 15320000 B SETGA ╨ÿ HOPMA╨¢╨¼H╨½╨Ö B╨½XO╨ö 15330000 SETGOFF TM PRMSTAT,X'0C' DEBUG OFF ? 15340000 BZ SETGA EC╨¢╨ÿ ╨öA, CPA╨ù╨ú B╨½XO╨ö 15350000 NI PRMSTAT,X'FF'-X'0C' C╨æPOC╨ÿT╨¼ ╨ƒP╨ÿ╨ùHAK DBG 15360000 SETGA XR R14,R14 RC = 0 15370000 SETGR RETURN 15380000 *********************************************************************** 15390000 LTORG 15400000 DROP BASE 15410000 *********************************************************************** 15420000 * SET TRANSLATE TABLE * 15430000 *********************************************************************** 15440000 * RETURN CODE = 0 - OK * 15450000 * RETURN CODE = 2 - ILLEGAL SET COMMAND * 15460000 *********************************************************************** 15470000 SETTRT SAVE 15480000 USING SETTRT,BASE 15490000 LR BASE,R14 15500000 MVC NEWTRT+7(1),0(R3) ╨ùA╨ƒPO╨¿EHA TRT ╨ƒO╨¢╨¼╨ùOBATE╨¢╨» 15510000 CLC NEWTRT(8),TRTNAME CPABH╨ÿT╨¼ C ╨ÿMEHEM TEK╨ú╨⌐E╨Ö TA╨æ╨¢╨ÿ╨ª╨½ 15520000 BE SETTOK EC╨¢╨ÿ ╨ÿMEHA COB╨ƒA╨¢╨ÿ, TO CPA╨ù╨ú B╨½XO╨ö 15530000 L PPTCBAR,CSAPPTBA ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC HA╨ºA╨¢A PPT 15540000 SETT02 CLC PPTPI(8),NEWTRT HA╨¿╨¢╨ÿ ╨ÿM╨» TA╨æ╨¢╨ÿ╨ª╨½ B PPT ? 15550000 BE SETT05 EC╨¢╨ÿ COB╨ƒA╨¢╨ÿ, TO TRT HA╨Ö╨öEHA 15560000 CLI PPTPI,X'FF' ╨öO╨¿╨¢╨ÿ ╨öO KOH╨ªA PPT ? 15570000 BE SETT04 EC╨¢╨ÿ ╨öA, TO TA╨æ╨¢╨ÿ╨ª╨½ HET 15580000 L R1,PPTNXTEN ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC C╨¢E╨ö. PPT 15590000 LR PPTCBAR,R1 ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC C╨¢E╨ö. PPT 15600000 B SETT02 ╨ÿ ╨ÿCKAT╨¼ ╨öA╨¢╨¼╨¿E 15610000 SETT04 LA R14,2 RC = 2 15620000 B SETTR 15630000 SETT05 EQU * 15640000 CLI TRTNAME,X'00' ECT╨¼ ╨ùA╨ôP╨ú╨ûEHHA╨» TA╨æ╨¢╨ÿ╨ªA ? 15650000 BE SETT06 HET 15660000 MVC TCAPCPI(8),TRTNAME ╨ùA╨ƒ╨ÿCAT╨¼ ╨ÿM╨» ╨ú╨öA╨¢╨»EMO╨Ö TA╨æ╨¢╨ÿ╨ª╨½ 15670000 L R5,A#TRT#AE ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC ╨ú╨öA╨¢╨»EMO╨Ö TA╨æ╨¢╨ÿ╨ª╨½ 15680000 ST R5,TCAPCLA ╨ùA╨ƒ╨ÿCAT╨¼ A╨öPEC ╨ú╨öA╨¢╨»EMO╨Ö TA╨æ╨¢╨ÿ╨ª╨½ 15690000 DFHPC TYPE=DELETE ╨ú╨öA╨¢╨ÿT╨¼ TEK╨ú╨⌐╨ú╨« TRT 15700000 SETT06 EQU * 15710000 MVC TCAPCPI(8),NEWTRT ╨ùA╨ƒ╨ÿCAT╨¼ ╨ÿM╨» ╨ùA╨ôP╨ú╨ûAEMO╨Ö TRT 15720000 DFHPC TYPE=LOAD ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ TA╨æ╨¢╨ÿ╨ª╨½ 15730000 L R5,TCAPCLA ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC TA╨æ╨¢╨ÿ╨ª 15740000 ST R5,A#TRT#AE ╨ùA╨ƒ╨ÿCAT╨¼ A╨öPEC BXO╨öHO╨Ö TA╨æ╨¢╨ÿ╨ª╨½ 15750000 LA R5,256(,R5) ╨ƒO╨¢╨ú╨º╨ÿT╨¼ A╨öPEC B╨½XO╨öHO╨Ö TA╨æ╨¢╨ÿ╨ª╨½ 15760000 ST R5,A#TRT#EA ╨ùA╨ƒ╨ÿCAT╨¼ A╨öPEC B╨½XO╨öHO╨Ö TA╨æ╨¢╨ÿ╨ª╨½ 15770000 MVC TRTNAME(8),NEWTRT ╨ùA╨ƒ╨ÿCAT╨¼ ╨ÿM╨» HOBO╨Ö TA╨æ╨¢╨ÿ╨ª╨½ 15780000 SETTOK XR R14,R14 RC = 0 15790000 SETTR RETURN 15800000 *********************************************************************** 15810000 LTORG 15820000 DROP BASE 15830000 *********************************************************************** 15840000 * SET FILE * 15850000 *********************************************************************** 15860000 * RETURN CODE = 0 - OK * 15870000 * RETURN CODE = 2 - ILLEGAL SET COMMAND * 15880000 *********************************************************************** 15890000 SETFILE SAVE 15900000 USING SETFILE,BASE 15910000 LR BASE,R14 15920000 CLC 0(3,R3),=C'BIN' SET FILE BINARY ? 15930000 BE SETF01 EC╨¢╨ÿ ╨öA, B╨½CTAB╨ÿT╨¼ BIN 15940000 CLC 0(3,R3),=C'TEX' SET FILE TEXT ? 15950000 BE SETF02 EC╨¢╨ÿ ╨öA, ╨úCTAHOB╨ÿT╨¼ TXT 15960000 LA R14,2 RC = 2 15970000 B SETFR 15980000 SETF01 NI PGMSTAT,X'FF'-X'40' B╨½CTAB╨ÿT╨¼ ╨ƒP╨ÿ╨ùHAK ╨öBO╨ÿ╨ºH╨½X ╨ñA╨Ö╨¢OB 15990000 B SETFOK 16000000 SETF02 OI PGMSTAT,X'40' B╨½CTAB╨ÿT╨¼ ╨ƒP╨ÿ╨ùHAK TEKCTOBO╨ôO ╨ñA╨Ö╨¢A 16010000 SETFOK XR R14,R14 RC = 0 16020000 SETFR RETURN 16030000 *********************************************************************** 16040000 LTORG 16050000 DROP BASE 16060000 *********************************************************************** 16070000 * ╨ƒO╨ö╨ƒPO╨ôPAMMA COURRS * 16080000 *********************************************************************** 16090000 * RETURN CODE = 0 - OK * 16100000 * RETURN CODE = 2 - BAD * 16110000 *********************************************************************** 16120000 COURRS SAVE 16130000 USING COURRS,BASE 16140000 LR BASE,R14 16150000 * 16160000 XC $RMA(4),$RMA 16170000 XC $SMA(4),$SMA 16180000 XC $FMA(4),$FMA 16190000 XC $DMA(4),$DMA 16200000 MVI #ERROR,E$OK 16210000 MVI RETCODE,E$OK 16220000 XC IND#CRLF(1),IND#CRLF 16230000 * 16240000 TM PRMSTAT,X'0C' DEBUG OFF ? 16250000 BZ COURRS00 ╨öA 16260000 MVC TCASCNB(2),D#REC DEBUG RECORD LENGHT 16270000 DFHSC TYPE=GETMAIN,CLASS=TRANSDATA 16280000 L TDOABAR,TCASCSA 16290000 ST TDOABAR,$DMA SAVE DEBUG MEMORY ADDRESS 16300000 * 16310000 COURRS00 EQU * 16320000 TM PGMSTAT,X'80' SEND ? 16330000 BZ COURRS10 HET 16340000 ******** SEND ********************************************************* 16350000 LH R1,PACKET MAX ╨ö╨¢╨ÿHA ╨ƒAKETA 16360000 LA R1,10(R1) +CHK +LEN +EOL +HA BC╨»K╨ÿ╨Ö C╨¢╨ú╨ºA╨Ö 16370000 STH R1,TCASCNB PA╨ùMEP ╨ùA╨ƒPA╨¿╨ÿBAEMO╨Ö ╨ƒAM╨»T╨ÿ 16380000 DFHSC TYPE=GETMAIN,CLASS=TERMINAL 16390000 L TIOABAR,TCASCSA 16400000 ST TIOABAR,$SMA SAVE SEND PACKET MEMORY ADDRESS 16410000 * 16420000 CALL SEND COURIER SEND 16430000 * 16440000 L TIOABAR,$SMA 16450000 ST TIOABAR,TCASCSA 16460000 DFHSC TYPE=FREEMAIN 16470000 * 16480000 B COURRS20 16490000 * 16500000 ******** RECEIVE ****************************************************** 16510000 COURRS10 EQU * 16520000 TM FILSTAT,X'C0' INTRA ? 16530000 BNO COURRS12 ╨úB╨½.. 16540000 MVC F#REC(2),I#REC INTRA RECORD LRECL 16550000 COURRS12 EQU * 16560000 LH R1,F#REC 16570000 LA R1,10(R1) + HA BC╨»K╨ÿ╨Ö C╨¢╨ú╨ºA╨Ö 16580000 STH R1,TCASCNB PA╨ùMEP ╨ùA╨ƒPA╨¿. ╨ƒAM╨»T╨ÿ 16590000 DFHSC TYPE=GETMAIN,CLASS=TRANSDATA 16600000 L TDOABAR,TCASCSA 16610000 ST TDOABAR,$FMA SAVE FILE MEMORY ADDRESS 16620000 * 16630000 DFHSC TYPE=GETMAIN,CLASS=TERMINAL,NUMBYTE=80 16640000 L TIOABAR,TCASCSA 16650000 ST TIOABAR,$SMA SAVE SEND PACKET MEMORY ADDRESS 16660000 * 16670000 CALL RECEIVE COURIER RECEIVE 16680000 * 16690000 L TIOABAR,$RMA 16700000 LTR TIOABAR,TIOABAR 16710000 BZ COURRS15 16720000 ST TIOABAR,TCASCSA 16730000 DFHSC TYPE=FREEMAIN 16740000 * 16750000 COURRS15 EQU * 16760000 L TIOABAR,$SMA 16770000 ST TIOABAR,TCASCSA 16780000 DFHSC TYPE=FREEMAIN 16790000 * 16800000 L TDOABAR,$FMA 16810000 ST TDOABAR,TCASCSA 16820000 LA R14,TDOAVRL 16830000 ST R14,TCATDAA 16840000 MVC TCATDDI(4),FILEDEST 16850000 DFHSC TYPE=FREEMAIN 16860000 * 16870000 COURRS20 EQU * 16880000 TM PRMSTAT,X'0C' DEBUG OFF ? 16890000 BZ COURRS30 ╨öA 16900000 L TDOABAR,$DMA 16910000 ST TDOABAR,TCASCSA 16920000 LA R14,TDOAVRL 16930000 ST R14,TCATDAA 16940000 MVC TCATDDI(4),DBGDEST 16950000 DFHSC TYPE=FREEMAIN 16960000 * 16970000 COURRS30 EQU * 16980000 CLI #ERROR,E$OK RETCODE OK ? 16990000 BE COURRS40 ╨öA 17000000 LA R14,2 RC = 2 17010000 B COURRS50 17020000 COURRS40 XR R14,R14 RC = 0 17030000 COURRS50 RETURN 17040000 *********************************************************************** 17050000 LTORG 17060000 DROP BASE 17070000 *********************************************************************** 17080000 * ╨ƒO╨ö╨ƒPO╨ôPAMMA O╨æPA╨æOTK╨ÿ KOMAH╨ö╨½ SEND * 17090000 *********************************************************************** 17100000 * RETURN CODE = 0 - OK * 17110000 * RETURN CODE = 8 - ILLEGAL SEND COMMAND * 17120000 *********************************************************************** 17130000 SEND SAVE 17140000 USING SEND,BASE 17150000 LR BASE,R14 17160000 MVC PACKAGE+1(37),=C'WAITING ..... SECONDS BEFORE SENDING.' 17170000 MVI PACKAGE,37 17180000 LH R1,DELAY ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ùHA╨ºEH╨ÿE ╨ùA╨öEP╨ûK╨ÿ 17190000 BINCVRT R1,PACKAGE+8,DBLWRK 17200000 CALL WRS B╨½╨öAT╨¼ COO╨æ╨⌐EH╨ÿE 17210000 CVD R1,DBLWRK ╨ƒO╨¢╨ú╨º╨ÿT╨¼ ╨ú╨ƒAKOBAHHOE ╨öEC╨»T╨ÿ╨ºHOE 17220000 MVC TCAICRT(4),DBLWRK+4 ╨ùA╨ƒ╨ÿCAT╨¼ ╨ùHA╨ºEH╨ÿE INTRVAL 17230000 DFHIC TYPE=WAIT,INTRVAL=YES 17240000 XC $GET$L(2),$GET$L TEK╨ú╨⌐A╨» ╨ƒO╨ù╨ÿ╨ª╨ÿ╨» B ╨ùA╨ƒ╨ÿC╨ÿ - 0 17250000 XC $RETRY(2),$RETRY ╨º╨ÿC╨¢O ╨ƒOBTOPOB ╨ƒEPE╨öA╨º╨ÿ => 0 17260000 XC $N$OLD(2),$N$OLD HOMEP ╨ƒAKETA => 0 17270000 MVI $STATE,C'S' SEND_INIT 17280000 MVI IND#CRLF,X'00' 17290000 *********************************************************************** 17300000 * OCHOBHO╨Ö ╨ª╨ÿK╨¢ SEND * 17310000 *********************************************************************** 17320000 SLOOP CLI $STATE,C'D' SEND_DATA ? 17330000 BNE SLOOP1 17340000 CALL SDATA 17350000 BRTORC SLOOP,REST=SLOOPER 17360000 SLOOP1 CLI $STATE,C'F' SEND_FILE_HEADER ? 17370000 BNE SLOOP2 17380000 CALL SFILE 17390000 BRTORC SLOOP,REST=SLOOPER 17400000 SLOOP2 CLI $STATE,C'S' SEND_INIT ? 17410000 BNE SLOOP3 17420000 CALL SINIT 17430000 BRTORC SLOOP,REST=SLOOPER 17440000 SLOOP3 CLI $STATE,C'Z' SEND_EOF ? 17450000 BNE SLOOP4 17460000 CALL SEOF 17470000 BRTORC SLOOP,REST=SLOOPER 17480000 SLOOP4 CLI $STATE,C'B' SEND_BREAK ? 17490000 BNE SLOOP5 17500000 CALL SBREAK 17510000 BRTORC SLOOP,REST=SLOOPER 17520000 SLOOP5 CLI $STATE,C'C' COMPLETE ? 17530000 BNE SLOOP6 17540000 BE COMPLETE 17550000 SLOOP6 CLI $STATE,C'A' SEND_ERR ? 17560000 BNE SLOOP7 17570000 SLOOPER CALL SABORT 17580000 B SENDRET 17590000 SLOOP7 MVI #ERROR,E$STATE HEPAC╨ƒO╨ùHAHHOE COCTO╨»H╨ÿE 17600000 CALL SABORT 17610000 B SENDRET 17620000 *********************************************************************** 17630000 * ╨ƒEPE╨öA╨ºA ╨ùAKOH╨ºEHA * 17640000 *********************************************************************** 17650000 COMPLETE XR R14,R14 RC = 0 17660000 SENDRET RETURN 17670000 *********************************************************************** 17680000 LTORG 17690000 DROP BASE 17700000 *********************************************************************** 17710000 * SEND_ERROR ╨ƒAKET "A" * 17720000 *********************************************************************** 17730000 * RETURN CODE = 0 - OK * 17740000 *********************************************************************** 17750000 SABORT SAVE 17760000 USING SABORT,BASE 17770000 LR BASE,R14 17780000 CLI #ERROR,E$ERR O╨æ╨¢OMA╨¢C╨» ╨ƒAPTHEP ? 17790000 BE SAB100 EC╨¢╨ÿ ╨öA, ╨ƒAKET HE ╨ƒOC╨½╨¢AT╨¼ 17800000 MVI $S$CUR,AE T╨ÿ╨ƒ ╨ƒAKETA - ERROR 17810000 MVC $SDAT$L(2),=H'30' ╨ö╨¢╨ÿHA COO╨æ╨¿EH╨ÿ╨» 17820000 MVC $N$OLD(2),$N$CUR C╨ÿHXPOH╨ÿ╨ù╨ÿPOBAT╨¼ HOMEPA ╨ƒAKETOB 17830000 XR R2,R2 17840000 IC R2,#ERROR ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ HOMEP O╨¿╨ÿ╨æK╨ÿ 17850000 MH R2,=H'30' ╨úMHO╨û╨ÿT╨¼ HA ╨ö╨¢╨ÿH╨ú COO╨æ╨⌐EH╨ÿ╨» 17860000 L R3,ERRTBL#A A╨öPEC TA╨æ╨¢╨ÿ╨ª╨½ ERROR COO╨æ╨⌐EH╨ÿ╨Ö 17870000 LA R3,0(R3,R2) ╨ƒO╨¢╨ú╨º╨ÿT╨¼ A╨öPEC COO╨æ╨⌐EH╨ÿ╨» 17880000 L TIOABAR,$SMA 17890000 LA R1,TIOADBA 17900000 LA R1,3(R1) 17910000 MVC 0(30,R1),0(R3) ╨ùA╨ƒ╨ÿCAT╨¼ TEKCT COO╨æ╨⌐EH╨ÿ╨» 17920000 L R2,A#TRT#EA A╨öPEC TA╨æ╨¢╨ÿ╨ª╨½ ╨ƒEPEKO╨ö╨ÿPOBK╨ÿ B ASCII 17930000 TR 0(30,R1),0(R2) ╨ƒEPEBECT╨ÿ B ASCII 17940000 CALL SPACK 17950000 SAB100 XR R14,R14 RC = 0 17960000 RETURN 17970000 *********************************************************************** 17980000 LTORG 17990000 DROP BASE 18000000 *********************************************************************** 18010000 * SEND_INIT ╨ƒAKET "S" * 18020000 *********************************************************************** 18030000 * RETURN CODE = 0 - OK * 18040000 * RETURN CODE = 2 - ╨ƒPEB╨½╨¿EHO ╨º╨ÿC╨¢O ╨ƒOBTOPOB ╨ƒEPE╨öA╨º╨ÿ. H╨ú╨ûEH E-╨ƒAKET* 18050000 *********************************************************************** 18060000 SINIT SAVE 18070000 USING SINIT,BASE 18080000 LR BASE,R14 18090000 * 18100000 L TIOABAR,$SMA 18110000 LA R1,TIOADBA 18120000 LA R5,32 X'20' - ╨ƒPO╨æE╨¢ B ASCII 18130000 LR R14,R5 CKO╨ƒ╨ÿPOBAT╨¼ 18140000 AH R5,PACKET ╨ƒP╨ÿ╨æAB╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú ╨ƒP╨ÿH╨ÿMAEMO╨ôO ╨ƒAKETA 18150000 STC R5,3(R1) ╨ƒEPB╨½╨Ö ╨æA╨ÖT SEND_INIT 18160000 LA R5,8(,R14) TIMEOUT = 8 18170000 STC R5,4(R1) BTOPO╨Ö ╨æA╨ÖT SEND_INIT 18180000 STC R14,5(R1) NPAD = 0 18190000 MVI 6(R1),X'40' PADC = NULL 18200000 IC R5,R#EOT 18210000 AR R5,R14 C╨öE╨¢AT╨¼ ╨ƒE╨ºATH╨½M 18220000 STC R5,7(R1) ╨ƒ╨»T╨½╨Ö ╨æA╨ÖT SEND_INIT 18230000 MVC 8(1,R1),QUOTE QUOTE CHARACTER 18240000 * 18250000 MVC $SDAT$L(2),=H'7' ╨ö╨¢╨ÿHA ╨ƒAKETA 18260000 MVC 9(1,R1),PREF ╨ƒPE╨ñ╨ÿKC BOC╨¼MO╨ôO ╨æ╨ÿTA 18270000 SINIT030 EQU * 18280000 CLC $RETRY(2),RETRY MO╨ûHO ╨ƒOBTOP╨»T╨¼ ╨ƒEPE╨öA╨º╨ú ? 18290000 BNL SINIT810 18300000 MVI $S$CUR,AS T╨ÿ╨ƒ ╨ƒAKETA - SEND_INIT 18310000 CALL SPACK ╨ƒO╨ö╨ƒPO╨ôPAMMA ╨ƒOC╨½╨¢K╨ÿ ╨ƒAKETA 18320000 BRTORC SINIT110,REST=SINIT810 18330000 SINIT110 CALL GETACK ╨º╨ÿTAT╨¼ OTBET ╨ƒAPTHEPA 18340000 BRTORC SINIT120,SINIT030,REST=SINIT810 18350000 SINIT120 CLI $RDAT$L+1,X'00' ECT╨¼ ╨öAHH╨½E B ╨ƒAKETE ? 18360000 BE SINIT300 EC╨¢╨ÿ HET, BCE ╨ƒO ╨úMO╨¢╨ºAH╨ÿ╨« 18370000 SR R4,R4 O╨º╨ÿCT╨ÿT╨¼ PA╨æO╨º╨ÿ╨Ö 18380000 * 18390000 L TIOABAR,$RMA A╨öPEC ╨æ╨ú╨ñEPA ╨ƒP╨ÿH╨»TO╨ôO ╨ƒAKETA 18400000 LA R2,TIOADBA 18410000 IC R4,3(R2) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú ╨ƒAKETA ╨ƒAPTHEPA 18420000 CH R4,=H'32' SPACE ?╨ƒO ╨úMO╨¢╨ºAH╨ÿ╨« ? 18430000 BE SINIT140 18440000 SH R4,=H'32' B╨½╨ºECT╨¼ ╨ƒPO╨æE╨¢ 18450000 CH R4,=H'26' ╨öO╨¢╨ûHA ╨æ╨½T╨¼ HE MEH╨¼╨¿E 26 18460000 BL SINIT800 18470000 CH R4,=H'94' HE MO╨ûET ╨æ╨½T╨¼ ╨æO╨¢╨¼╨¿E PACKET 18480000 BH SINIT800 EC╨¢╨ÿ ╨æO╨¢╨¼╨¿E, O╨¿╨ÿ╨æKA 18490000 STH R4,PACKET ╨ùA╨ƒ╨ÿCAT╨¼ ╨ö╨¢╨ÿH╨ú ╨ƒAKETA ╨ö╨¢╨» ╨ƒAPTHEPA 18500000 SINIT140 CLC $RDAT$L(2),=H'5' ECT╨¼ EOL ? 18510000 BNH SINIT300 EC╨¢╨ÿ HET, HE MEH╨»T╨¼ CTAP╨½╨Ö 18520000 IC R4,7(R2) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ EOL 18530000 SH R4,=H'32' B╨½╨ºECT╨¼ ╨ƒPO╨æE╨¢ 18540000 STC R4,S#EOT ╨ùA╨ƒ╨ÿCAT╨¼ EOL ╨ö╨¢╨» ╨ƒAPTHEPA 18550000 CLI $RDAT$L+1,7 ECT╨¼ ╨ƒPE╨ñ╨ÿKC BOC╨¼MO╨ôO ╨æ╨ÿTA ? 18560000 BL SINIT300 EC╨¢╨ÿ HET, HET ╨ƒPE╨ñ╨ÿKCA╨ª╨ÿ╨ÿ 8 ╨æ╨ÿTA 18570000 CLC 9(1,R2),PREF COB╨ƒA╨¢ C HA╨¿╨ÿM ╨ƒPE╨ñ╨ÿKCOM ? 18580000 BE SINIT400 EC╨¢╨ÿ ╨öA, OCTAB╨ÿT╨¼ 18590000 SINIT300 NI PGMSTAT,X'FF'-X'20' HET ╨ƒPE╨ñ╨ÿKCA╨ª╨ÿ╨ÿ 8-╨ôO ╨æ╨ÿTA 18600000 SINIT400 MVI $STATE,C'F' FILE_HEADER 18610000 LH R3,$N$OLD ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ HOMEP ╨ƒAKETA 18620000 LA R3,1(,R3) ╨úBE╨¢╨ÿ╨º╨ÿT╨¼ HOMEP HA 1 18630000 STH R3,$N$OLD ╨ùA╨ƒ╨ÿCAT╨¼ O╨æPATHO 18640000 NC $N$OLD(2),=X'003F' $N$OLD MOD 64 18650000 XR R14,R14 RC = 0 18660000 B SINITRET 18670000 SINIT800 MVI #ERROR,E$LENG HEBEPHA╨» ╨ö╨¢╨ÿHA ╨ƒAKETA 18680000 SINIT810 MVI $STATE,C'A' A B O R T 18690000 LA R14,2 RC = 2 18700000 SINITRET RETURN 18710000 *********************************************************************** 18720000 LTORG 18730000 DROP BASE 18740000 *********************************************************************** 18750000 * SEND_FILE ╨ƒAKET "F" * 18760000 *********************************************************************** 18770000 * RETURN CODE = 0 - OK * 18780000 * RETURN CODE = 2 - ╨ƒOC╨¢AT╨¼ ERROR ╨ƒAKET * 18790000 * RETURN CODE = 4 - ╨ƒP╨ÿH╨»╨¢╨ÿ ERROR ╨ƒAKET, B╨½XO╨ö ╨æE╨ù ERROR ╨ƒAKETA * 18800000 *********************************************************************** 18810000 SFILE SAVE 18820000 USING SFILE,BASE 18830000 LR BASE,R14 18840000 L TIOABAR,$SMA 18850000 LA R1,TIOADBA A╨öPEC HA╨ºA╨¢A ╨ƒAKETA 18860000 LA R1,3(R1) A╨öPEC ╨öAHH╨½X ╨ƒAKETA 18870000 L R3,A#TRT#EA A╨öPEC TA╨æ╨¢╨ÿ╨ª╨½ TRT EBCDIC -> ASCII 18880000 * ╨ñOPM╨ÿPOBAH╨ÿE ╨ÿMEH╨ÿ ╨ñA╨Ö╨¢A ╨ƒO ╨ƒPOTOKO╨¢╨ú COURIER 18890000 MVC 0(4,R1),FILEDEST ╨ùA╨ƒ╨ÿCAT╨¼ ╨ÿM╨» 18900000 MVC 4(8,R1),=C'0001.KER' 18910000 LA R2,12 ╨ƒO╨¢╨ú╨º╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú ╨ÿMEH╨ÿ 18920000 STH R2,$SDAT$L ╨ùA╨ƒ╨ÿCAT╨¼ ╨ö╨¢╨ÿH╨ú ╨öAHH╨½X ╨ƒAKETA 18930000 BCTR R2,0 18940000 EX R2,SFILE600 ╨ƒEPEKO╨ö╨ÿPOBAT╨¼ B ASCII 18950000 SFILE050 EQU * 18960000 CLC $RETRY,RETRY MO╨ûHO E╨⌐E ╨ƒOC╨½╨¢AT╨¼ ? 18970000 BNL SFILE800 HET 18980000 MVI $S$CUR,AF T╨ÿ╨ƒ ╨ƒAKETA - FILE_HEADER 18990000 CALL SPACK ╨ƒO╨ö╨ƒPO╨ôPAMMA ╨ƒOC╨½╨¢K╨ÿ ╨ƒAKETA 19000000 BRTORC SFILE100,REST=SFILE800 19010000 SFILE100 CALL GETACK ╨º╨ÿTAT╨¼ OTBET ╨ƒAPTHEPA 19020000 BRTORC SFILE120,SFILE050,REST=SFILE800 19030000 SFILE120 MVI $STATE,C'D' D A T A 19040000 LH R3,$N$OLD ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ HOMEP ╨ƒAKETA 19050000 LA R3,1(,R3) ╨úBE╨¢╨ÿ╨º╨ÿT╨¼ HA 1 19060000 STH R3,$N$OLD ╨ùA╨ƒ╨ÿCAT╨¼ O╨æPATHO 19070000 NC $N$OLD(2),=X'003F' $N$OLD MOD 64 19080000 CALL GTCHR ╨ùA╨ƒO╨¢H╨ÿT╨¼ ╨æ╨ú╨ñEP ╨öAHH╨½M╨ÿ 19090000 BRTORC SFILE700,REST=SFILE800 19100000 SFILE700 XR R14,R14 RC = 0 19110000 B SFILERET 19120000 * 19130000 SFILE600 TR 0(0,R1),0(R3) ╨ƒEPEKO╨ö╨ÿPOBKA B ASCII 19140000 * 19150000 SFILE800 MVI $STATE,C'A' ╨ƒPEB╨½╨¿EHO ╨º╨ÿC╨¢O ╨ƒOBTOPOB ╨ƒEPE╨öA╨º╨ÿ 19160000 SFILE900 LA R14,2 RC = 2 19170000 SFILERET RETURN 19180000 *********************************************************************** 19190000 LTORG 19200000 DROP BASE 19210000 *********************************************************************** 19220000 * SEND_DATA ╨ƒAKET "D" * 19230000 *********************************************************************** 19240000 * RETURN CODE = 0 - OK * 19250000 * RETURN CODE = 2 - ╨ƒOC╨¢AT╨¼ ERROR ╨ƒAKET * 19260000 *********************************************************************** 19270000 SDATA SAVE 19280000 USING SDATA,BASE 19290000 LR BASE,R14 19300000 * 19310000 SDATA030 EQU * 19320000 CLC $RETRY,RETRY MO╨ûHO ╨ƒOBTOP╨»T╨¼ ╨ƒEPE╨öA╨º╨ú ? 19330000 BNL SDATA800 19340000 MVI $S$CUR,AD T╨ÿ╨ƒ ╨ƒAKETA - D A T A 19350000 CALL SPACK ╨ƒO╨ö╨ƒPO╨ôPAMMA ╨ƒOC╨½╨¢K╨ÿ ╨ƒAKETA 19360000 BRTORC SDATA060,REST=SDATA800 19370000 SDATA060 CALL GETACK ╨º╨ÿTAT╨¼ OTBET ╨ƒAPTHEPA 19380000 BRTORC SDATA100,SDATA030,REST=SDATA800 19390000 SDATA100 EQU * 19400000 XC $SDAT$L(2),$SDAT$L ╨ƒAKET ╨ƒOC╨¢AH ╨ÿ ╨ƒO╨öTBEP╨û╨öEH 19410000 LH R3,$N$OLD ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ HOMEP ╨ƒAKETA 19420000 LA R3,1(,R3) ╨úBE╨¢╨ÿ╨º╨ÿT╨¼ HA 1 19430000 STH R3,$N$OLD ╨ùA╨ƒ╨ÿCAT╨¼ O╨æPATHO 19440000 NC $N$OLD(2),=X'003F' $N$OLD MOD 64 19450000 CALL GTCHR ╨ùA╨ƒO╨¢H╨ÿT╨¼ ╨ƒAKET ╨öAHH╨½M╨ÿ 19460000 BRTORC SDATA700,REST=SDATA800 19470000 SDATA700 XR R14,R14 RC = 0 19480000 B SDATARET 19490000 SDATA800 MVI $STATE,C'A' ╨ƒPEB╨½╨¿EHO ╨º╨ÿC╨¢O ╨ƒOBTOPOB ╨ƒEPE╨öA╨º╨ÿ 19500000 LA R14,2 RC = 2 19510000 SDATARET RETURN 19520000 *********************************************************************** 19530000 LTORG 19540000 DROP BASE 19550000 *********************************************************************** 19560000 * SEND_EOF ╨ƒAKET "Z" * 19570000 *********************************************************************** 19580000 * RETURN CODE = 0 - OK * 19590000 * RETURN CODE = 2 - ╨ƒOC╨¢AT╨¼ ERROR ╨ƒAKET * 19600000 *********************************************************************** 19610000 SEOF SAVE 19620000 USING SEOF,BASE 19630000 LR BASE,R14 19640000 * 19650000 LH R1,$SDAT$L 19660000 LTR R1,R1 19670000 BZ SEOF430 19680000 * 19690000 SEOF030 EQU * 19700000 CLC $RETRY,RETRY MO╨ûHO ╨ƒOC╨½╨¢AT╨¼ ╨ƒAKET ? 19710000 BNL SEOF800 HET 19720000 MVI $S$CUR,AD T╨ÿ╨ƒ ╨ƒAKETA - D A T A 19730000 MVI $STATE,C'D' T╨ÿ╨ƒ ╨ƒAKETA - D A T A 19740000 CALL SPACK ╨ƒO╨ö╨ƒPO╨ôPAMMA ╨ƒOC╨½╨¢K╨ÿ ╨ƒAKETA 19750000 BRTORC SEOF060,REST=SEOF800 19760000 SEOF060 CALL GETACK ╨º╨ÿTAT╨¼ OTBET ╨ƒAPTHEPA 19770000 BRTORC SEOF100,SEOF030,REST=SEOF800 19780000 SEOF100 EQU * 19790000 LH R3,$N$OLD ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ HOMEP ╨ƒAKETA 19800000 LA R3,1(,R3) ╨úBE╨¢╨ÿ╨º╨ÿT╨¼ HA 1 19810000 STH R3,$N$OLD ╨ùA╨ƒ╨ÿCAT╨¼ O╨æPATHO 19820000 NC $N$OLD(2),=X'003F' $N$OLD MOD 64 19830000 XC $SDAT$L(2),$SDAT$L ╨ö╨¢╨ÿHA ╨ƒAKETA = 0 19840000 MVI $STATE,C'Z' 19850000 XR R14,R14 RC = 0 19860000 B SEOFRET 19870000 * 19880000 SEOF430 EQU * 19890000 CLC $RETRY,RETRY MO╨ûHO ╨ƒOC╨½╨¢AT╨¼ ╨ƒAKET ? 19900000 BNL SEOF800 HET 19910000 MVI $S$CUR,AZ T╨ÿ╨ƒ ╨ƒAKETA - EOF 19920000 XC $SDAT$L(2),$SDAT$L ╨ö╨¢╨ÿHA ╨ƒAKETA = 0 19930000 CALL SPACK ╨ƒO╨ö╨ƒPO╨ôPAMMA ╨ƒOC╨½╨¢K╨ÿ ╨ƒAKETA 19940000 BRTORC SEOF460,REST=SEOF800 19950000 SEOF460 CALL GETACK ╨º╨ÿTAT╨¼ OTBET ╨ƒAPTHEPA 19960000 BRTORC SEOF500,SEOF430,REST=SEOF800 19970000 SEOF500 EQU * 19980000 LH R3,$N$OLD ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ HOMEP ╨ƒAKETA 19990000 LA R3,1(,R3) ╨úBE╨¢╨ÿ╨º╨ÿT╨¼ HA 1 20000000 STH R3,$N$OLD ╨ùA╨ƒ╨ÿCAT╨¼ O╨æPATHO 20010000 NC $N$OLD(2),=X'003F' $N$OLD MOD 64 20020000 MVI $STATE,C'B' COCTO╨»H╨ÿE BREAK - ╨ƒEPE╨öAETC╨» 1 ╨ñA╨Ö╨¢ 20030000 XR R14,R14 RC = 0 20040000 B SEOFRET 20050000 SEOF800 MVI $STATE,C'A' ╨ƒOC╨¢AT╨¼ ERROR ╨ƒAKET 20060000 LA R14,2 RC = 2 20070000 SEOFRET RETURN 20080000 *********************************************************************** 20090000 LTORG 20100000 DROP BASE 20110000 *********************************************************************** 20120000 * SEND_BREAK ╨ƒAKET "B" * 20130000 *********************************************************************** 20140000 * RETURN CODE = 0 - OK * 20150000 * RETURN CODE = 2 - ╨ƒOC╨¢AT╨¼ ERROR ╨ƒAKET * 20160000 *********************************************************************** 20170000 SBREAK SAVE 20180000 USING SBREAK,BASE 20190000 LR BASE,R14 20200000 MVI $S$CUR,AB T╨ÿ╨ƒ ╨ƒAKETA - BREAK 20210000 XC $SDAT$L(2),$SDAT$L ╨ö╨¢╨ÿHA ╨ƒAKETA = 0 20220000 SBRE030 EQU * 20230000 CLC $RETRY,RETRY MO╨ûHO ╨ƒOC╨½╨¢AT╨¼ ╨ƒAKET ? 20240000 BNL SBRE800 20250000 CALL SPACK ╨ƒO╨ö╨ƒPO╨ôPAMMA ╨ƒOC╨½╨¢K╨ÿ ╨ƒAKETA 20260000 BRTORC SBRE060,REST=SBRE800 20270000 SBRE060 CALL GETACK ╨º╨ÿTAT╨¼ OTBET ╨ƒAPTHEPA 20280000 BRTORC SBRE100,SBRE030,REST=SBRE800 20290000 SBRE100 MVI $STATE,C'C' $STATE COMPLETE 20300000 XR R14,R14 RC = 0 20310000 B SBRKRET 20320000 SBRE800 MVI $STATE,C'A' ╨ƒOC╨¢AT╨¼ ERROR ╨ƒEPE╨öA╨º 20330000 LA R14,2 RC = 2 20340000 SBRKRET RETURN 20350000 *********************************************************************** 20360000 LTORG 20370000 DROP BASE 20380000 *********************************************************************** 20390000 * ╨ƒO╨ö╨ƒPO╨ôPAMMA ╨ºTEH╨ÿ╨» OTBETA ╨ƒAPTHEPA * 20400000 *********************************************************************** 20410000 * RETURN CODE = 0 - OK * 20420000 * RETURN CODE = 2 - ╨úTEP╨»H ╨ƒAKET (H╨ú╨ûHO ╨ƒOBTOP╨ÿT╨¼ ╨ƒOC╨¢. ╨ƒAKET) 20430000 * RETURN CODE = 4 - O╨æ╨¢OMA╨¢C╨» ╨ƒAPTHEP * 20440000 *********************************************************************** 20450000 GETACK SAVE 20460000 USING GETACK,BASE 20470000 LR BASE,R14 20480000 * 20490000 GACK010 CALL RPACK ╨ƒO╨ö╨ƒPO╨ôPAMMA ╨ºTEH╨ÿ╨» ╨ƒAKETOB ╨ƒAPTHEPA 20500000 BRTORC GACK020,REST=GACK050 20510000 GACK020 EQU * 20520000 CLI $R$CUR,AE ╨ƒP╨ÿH╨»T ERROR ╨ƒAKET ? 20530000 BE GACK100 ╨öA, O╨æBA╨¢╨ÿ╨¢C╨» ╨ƒAPTHEP 20540000 CLI $R$CUR,AY ACK ? 20550000 BE GACK200 ╨öA 20560000 CLI $R$CUR,AN NAK ? 20570000 BE GACK300 ╨öA 20580000 MVI #ERROR,E$TYPE 20590000 GACK050 MVI $S$CUR,AN ╨ƒOBTOP╨ÿT╨¼ ╨ƒOC╨¢E╨öH╨ÿ╨Ö ╨ƒAKET 20600000 LA R14,2 RC = 2 20610000 B GACKR 20620000 GACK100 MVI #ERROR,E$ERR 20630000 MVI $STATE,C'A' 20640000 LA R14,4 RC = 4 20650000 B GACKR 20660000 * 20670000 GACK200 CLC $N$OLD,$N$CUR CPABH╨ÿT╨¼ HOMEPA ╨ƒAKETOB 20680000 BE GACK800 20690000 MVI #ERROR,E$BAD ╨úTEP╨»H ╨ƒAKET 20700000 B GACK700 ╨ƒOBTOP╨ÿT╨¼ ╨ƒOC╨¢E╨öH╨ÿ╨Ö ╨ƒAKET 20710000 * 20720000 GACK300 MVI #ERROR,E$NAK NAK OT ╨ƒAPTHEPA 20730000 LH R5,$N$CUR ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ HOMEP ╨ƒP╨ÿH╨»TO╨ôO ╨ƒAKETA 20740000 BCTR R5,0 20750000 N R5,=X'0000003F' $N$CUR MOD 64 20760000 CH R5,$N$OLD CPABH╨ÿT╨¼ C HOMEPOM ╨ƒOC╨¢E╨öH. ╨ƒAKETA 20770000 BNE GACK700 O╨æ╨½╨ºH╨½╨Ö NAK, ╨ƒOBTOP╨ÿT╨¼ ╨ƒOC╨¢. ╨ƒAKET 20780000 * NAK C HOMEPOM N+1 => ╨æ╨½╨¢ ACK C HOMEPOM N 20790000 MVI $R$CUR,AY ╨ùA╨ƒ╨ÿCAT╨¼ T╨ÿ╨ƒ ╨ƒAKETA ACK 20800000 MVI $RDAT$L+1,X'00' ╨ùA╨ƒ╨ÿCAT╨¼ ╨ö╨¢╨ÿH╨ú ╨öAHH╨½X = 0 20810000 STH R5,$N$CUR ╨ùA╨ƒ╨ÿCAT╨¼ HOMEP ╨ƒAKETA 20820000 B GACK800 20830000 GACK700 MVI $S$CUR,AN 20840000 LA R14,2 RC = 2 20850000 B GACKR 20860000 GACK800 XR R14,R14 RC = 0 20870000 GACKR RETURN 20880000 *********************************************************************** 20890000 LTORG 20900000 DROP BASE 20910000 *********************************************************************** 20920000 * ╨ƒO╨ö╨ƒPO╨ôPAMMA ╨ùA╨ƒO╨¢HEH╨ÿ╨» ╨ƒAKETA ╨öAHH╨½M╨ÿ * 20930000 *********************************************************************** 20940000 * RETURN CODE = 0 - OK * 20950000 * RETURN CODE = 2 - ERROR (H╨ú╨ûEH ERROR-╨ƒAKET) * 20960000 *********************************************************************** 20970000 GTCHR SAVE 20980000 USING GTCHR,BASE 20990000 LR BASE,R14 21000000 * 21010000 L TIOABAR,$SMA 21020000 LA R2,TIOADBA+3 A╨öPEC CBO╨æO╨öHO╨ôO MECTA B ╨ƒAKETE 21030000 XR R3,R3 ╨úKA╨ùATE╨¢╨¼ CME╨⌐EH╨ÿ╨»/╨ö╨¢╨ÿHA ╨ƒAKETA 21040000 * 21050000 GCHR010 LH R1,$GET$L 21060000 LTR R1,R1 ╨ùA╨ƒ╨ÿC╨¼ FILE ╨ƒO╨¢HOCT╨¼╨« O╨æPA╨æOTAHA ? 21070000 BNZ GCHR300 HET 21080000 TM PGMSTAT,X'40' TEXT ? 21090000 BNO GCHR100 HET 21100000 * 21110000 CLI IND#CRLF,X'00' CRLF ╨úC╨ƒE╨¢╨ÿ B╨½BECT╨ÿ ? 21120000 BE GCHR100 ╨öA 21130000 CLI IND#CRLF,X'4D' CR ╨úC╨ƒE╨¢╨ÿ B╨½BECT╨ÿ ? 21140000 BNE GCHR040 ╨öA 21150000 LH R15,PACKET 21160000 SH R15,=H'3' 21170000 SH R15,=H'2' 21180000 CR R3,R15 ╨ƒOMECT╨ÿT╨¼C╨» <QUOTE><CR> ? 21190000 BH GCHR700 HET 21200000 LA R15,0(R3,R2) A╨öPEC CBO╨æO╨öHO╨ôO MECTA B ╨ƒAKETE 21210000 MVC 0(1,R15),QUOTE 21220000 MVI 1(R15),X'4D' PUT CR 21230000 LA R3,2(R3) 21240000 MVI IND#CRLF,X'4A' 21250000 GCHR040 LH R15,PACKET 21260000 SH R15,=H'3' 21270000 SH R15,=H'2' 21280000 CR R3,R15 ╨ƒOMECT╨ÿT╨¼C╨» <QUOTE><LF> ? 21290000 BH GCHR700 HET 21300000 LA R15,0(R3,R2) A╨öPEC CBO╨æO╨öHO╨ôO MECTA B ╨ƒAKETE 21310000 MVC 0(1,R15),QUOTE 21320000 MVI 1(R15),X'4A' PUT LF 21330000 LA R3,2(R3) 21340000 MVI IND#CRLF,X'00' 21350000 * 21360000 GCHR100 CALL GTREC ╨ƒO╨ö╨ƒPO╨ôPAMMA ╨ºTEH╨ÿ╨» ╨ùA╨ƒ╨ÿC╨ÿ 21370000 BRTORC GCHR120,GCHR800,GCHR820,REST=GCHR840 21380000 GCHR120 L R4,$FMA A╨öPEC HEO╨æPA╨æOTAHH╨½X ╨öAHH╨½X FILE 21390000 LH R1,$GET$L ╨ö╨¢╨ÿH╨ú HEO╨æPA╨æOTAHH╨½X ╨öAHH╨½X FILE 21400000 TM PGMSTAT,X'40' TEXT ? 21410000 BNO GCHR300 HET. HE ╨ƒEPEKO╨ö╨ÿPOBAT╨¼. 21420000 * 21430000 L R6,A#TRT#EA A╨öPEC TA╨æ╨¢╨ÿ╨ª╨½ ╨ƒEPEKO╨ö╨ÿPOBK╨ÿ 21440000 LR R15,R4 A╨öPEC RECORD FILE DATA 21450000 LR R14,R1 ╨ö╨¢╨ÿHA RECORD FILE DATA 21460000 GCHR200 CH R14,=H'256' 21470000 BNH GCHR240 21480000 TR 0(256,R15),0(R6) ╨ƒEPEKO╨ö╨ÿPOBAT╨¼ B ASCII 21490000 SH R14,=H'256' 21500000 LA R15,256(R15) 21510000 B GCHR200 21520000 * 21530000 GCHR220 TR 0(0,R15),0(R6) ╨ƒEPEKO╨ö╨ÿPOBAT╨¼ B ASCII 21540000 * 21550000 GCHR240 BCTR R14,0 ╨ö╨¢╨» TR 21560000 EX R14,GCHR220 21570000 LA R14,0(R1,R4) A╨öPEC ╨ƒOC╨¢E╨öHE╨ôO ╨æA╨ÖTA ╨ùA╨ƒ╨ÿC╨ÿ 21580000 BCTR R14,0 21590000 * 21600000 GCHR260 CLI 0(R14),X'20' ╨ƒPO╨æE╨¢ ? 21610000 BNE GCHR280 EC╨¢╨ÿ HET, TO B╨½XO╨ö 21620000 BCTR R14,0 ╨ƒEPEMECT╨ÿT╨¼ HA 1 ╨æA╨ÖT HA╨ùA╨ö 21630000 CR R14,R4 ╨ƒO╨ƒA╨¢╨ÿ HA HA╨ºA╨¢O ╨ùA╨ƒ╨ÿC╨ÿ ? 21640000 BH GCHR260 HET, ╨ƒPOBEP╨»T╨¼ ╨öA╨¢EE 21650000 XC $GET$L(2),$GET$L ╨ùA╨ƒ╨ÿC╨¼ H╨ú╨¢EBO╨Ö ╨ö╨¢╨ÿH╨½ 21660000 MVI IND#CRLF,X'4D' 21670000 B GCHR010 21680000 * 21690000 GCHR280 LA R1,1(R14) 21700000 SR R1,R4 21710000 STH R1,$GET$L ╨ö╨¢╨ÿHA ╨öAHH╨½X ╨æE╨ù KOHE╨ºH╨½X ╨ƒPO╨æE╨¢OB 21720000 B GCHR310 21730000 * 21740000 GCHR300 L R4,$FMA A╨öPEC HEO╨æPA╨æOTAHH╨½X ╨öAHH╨½X FILE 21750000 GCHR310 LH R1,$GET$L ╨ö╨¢╨ÿHA HEO╨æPA╨æOTAHH╨½X ╨öAHH╨½X FILE 21760000 XR R5,R5 CME╨⌐EH╨ÿE C╨ÿMBO╨¢A B FILE 21770000 GCHR400 EQU * 21780000 LA R6,0(R5,R4) A╨öPEC O╨ºEPE╨öHO╨ôO C╨ÿMBO╨¢A 21790000 IC R0,0(R6) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ O╨ºEPE╨öHO╨Ö C╨ÿMBO╨¢ 21800000 TM PGMSTAT,X'20' ECT╨¼ ╨ƒPE╨ñ╨ÿKCA╨ª╨ÿ╨» 8-╨ôO ╨æ╨ÿTA ? 21810000 BZ GCHR440 HET 21820000 TM 0(R6),X'80' ECT╨¼ 8-O╨Ö ╨æ╨ÿT ? 21830000 BZ GCHR420 HET 21840000 * C╨ÿMBO╨¢ C 8-M ╨æ╨ÿTOM 21850000 LH R15,PACKET ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ MAKC. ╨ö╨¢╨ÿH╨ú ╨ƒAKETA 21860000 SH R15,=H'3' ╨ö╨¢╨ÿHA - 3 ╨ú╨ƒPAB╨¢. C╨ÿMBO╨¢A ╨ƒAKETA 21870000 SH R15,=H'3' 21880000 CR R3,R15 ╨ƒOMECT╨ÿT╨¼C╨» 3 C╨ÿMBO╨¢A ? 21890000 BH GCHR700 HET, B╨½╨öAT╨¼ ╨ƒAKET 21900000 N R0,=X'0000007F' C╨æPOC╨ÿT╨¼ 8-O╨Ö ╨æ╨ÿT 21910000 STC R0,0(R6) ╨ùA╨ƒ╨ÿCAT╨¼ O╨æPATHO ╨æE╨ù 8-╨ôO ╨æ╨ÿTA 21920000 LA R15,0(R3,R2) 21930000 MVC 0(1,R15),PREF ╨ùA╨ƒ╨ÿCAT╨¼ ╨ƒPE╨ñ╨ÿKC B ╨ƒAKET 21940000 LA R3,1(R3) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ B ╨ƒAKETE 21950000 * 21960000 GCHR420 XR R14,R14 21970000 IC R14,PREF 21980000 CR R0,R14 ╨ƒO╨¢╨ú╨º╨ÿ╨¢C╨» PREF ? 21990000 BE GCHR460 EC╨¢╨ÿ ╨öA, H╨ú╨ûHA ╨ƒPE╨ñ╨ÿKCA╨ª╨ÿ╨» 22000000 GCHR440 XR R14,R14 22010000 IC R14,QUOTE 22020000 CR R0,R14 CPABH╨ÿT╨¼ C QUOTE 22030000 BE GCHR460 EC╨¢╨ÿ COB╨ƒA╨¢╨ÿ, TO H╨ú╨ûHA ╨ƒPE╨ñ╨ÿKCA╨ª╨ÿ╨» 22040000 CH R0,=H'127' D E L ? 22050000 BE GCHR460 DEL TO╨ûE C╨ƒE╨ªC╨ÿMBO╨¢ 22060000 CH R0,=H'32' CPABH╨ÿT╨¼ C ╨ƒPO╨æE╨¢OM 22070000 BNL GCHR500 EC╨¢╨ÿ HE MEH╨¼╨¿E, TO O╨æ╨½╨ºH╨½╨Ö C╨ÿMBO╨¢ 22080000 GCHR460 LH R15,PACKET ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ MAKC. ╨ö╨¢╨ÿH╨ú ╨ƒAKETA 22090000 SH R15,=H'3' B╨½╨ºECT╨¼ ╨ö╨¢╨ÿH╨ú ╨ú╨ƒPAB╨¢╨»╨«╨⌐╨ÿX C╨ÿMBO╨¢OB 22100000 SH R15,=H'2' 22110000 CR R3,R15 ╨ƒOMECT╨ÿT╨¼C╨» 2 C╨ÿMBO╨¢A ? 22120000 BH GCHR700 EC╨¢╨ÿ HET, B╨½╨öAT╨¼ ╨ƒAKET 22130000 LA R15,0(R3,R2) ╨ùA╨ƒ╨ÿCAT╨¼ QUOTE 22140000 MVC 0(1,R15),QUOTE ╨ùA╨ƒ╨ÿCAT╨¼ QUOTE 22150000 LA R3,1(R3) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ B ╨ƒAKETE 22160000 IC R14,PREF 22170000 CR R0,R14 PREF ? 22180000 BE GCHR500 EC╨¢╨ÿ ╨öA, 100 HE ╨ƒP╨ÿ╨æAB╨¢╨»T╨¼ 22190000 IC R14,QUOTE 22200000 CR R0,R14 QUOTE ? 22210000 BE GCHR500 EC╨¢╨ÿ ╨öA, 100 HE ╨ƒP╨ÿ╨æAB╨¢╨»T╨¼ 22220000 X R0,=X'00000040' B╨½╨ƒO╨¢H╨ÿT╨¼ ╨ñ╨úHK╨ª╨ÿ╨« CHAR 22230000 * 22240000 GCHR500 EQU * 22250000 LH R15,PACKET ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ MAKC. ╨ö╨¢╨ÿH╨ú ╨ƒAKETA 22260000 SH R15,=H'3' B╨½╨ºECT╨¼ ╨ö╨¢╨ÿH╨ú ╨ú╨ƒPAB╨¢╨»╨«╨⌐╨ÿX C╨ÿMBO╨¢OB 22270000 BCTR R15,0 ECT╨¼ MECTO 22280000 CR R3,R15 ╨ö╨¢╨» 1 C╨ÿMBO╨¢A ? 22290000 BH GCHR700 HET 22300000 STC R0,0(R3,R2) ╨ùA╨ƒ╨ÿCAT╨¼ C╨ÿMBO╨¢ B SDAT 22310000 LA R3,1(R3) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ B ╨ƒAKETE 22320000 LA R5,1(R5) ╨ƒEPEMECT╨ÿT╨¼ BXO╨öHO╨Ö ╨úKA╨ùATE╨¢╨¼ 22330000 BCT R1,GCHR400 KOHE╨ª ╨ùA╨ƒ╨ÿC╨ÿ ? 22340000 XC $GET$L(2),$GET$L ╨öA 22350000 TM PGMSTAT,X'40' TEXT ? 22360000 BNO GCHR010 HET 22370000 MVI IND#CRLF,X'4D' ╨öA 22380000 B GCHR010 22390000 * 22400000 GCHR700 LA R15,0(R5,R4) 22410000 ST R15,$FMA ╨ùA╨ƒ╨ÿCAT╨¼ A╨öPEC HEO╨æPA╨æOT. ╨öAHH╨½X 22420000 STH R1,$GET$L ╨ùA╨ƒ╨ÿCAT╨¼ ╨ö╨¢╨ÿH╨ú HEO╨æPA╨æOT. ╨öAHH╨½X 22430000 STH R3,$SDAT$L ╨ùA╨ƒ╨ÿCAT╨¼ ╨ö╨¢╨ÿH╨ú ╨öAHH╨½X B ╨ƒAKETE 22440000 XR R14,R14 RC = 0 22450000 B GCHRRET ╨ÿ BO╨ùBPAT 22460000 * 22470000 GCHR800 MVI $STATE,C'Z' COCTO╨»H╨ÿE EOF 22480000 STH R3,$SDAT$L ╨ùA╨ƒ╨ÿCAT╨¼ ╨ö╨¢╨ÿH╨ú ╨öAHH╨½X B ╨ƒAKETE 22490000 XR R14,R14 RC = 0 22500000 B GCHRRET ╨ÿ BO╨ùBPAT 22510000 GCHR820 MVI #ERROR,E$PIO ╨ƒOCTO╨»HHA╨» O╨¿╨ÿ╨æKA B/B 22520000 B GCHR850 ╨ÿ B╨½XO╨ö 22530000 GCHR840 MVI #ERROR,E$CICS HE╨ƒOH╨»THA╨» O╨¿╨ÿ╨æKA CICS 22540000 GCHR850 MVI $STATE,C'A' COCTO╨»H╨ÿE ABORT 22550000 LA R14,2 RC = 2 22560000 GCHRRET RETURN 22570000 *********************************************************************** 22580000 LTORG 22590000 DROP BASE 22600000 *********************************************************************** 22610000 * ╨ºTEH╨ÿE O╨ºEPE╨öHO╨Ö ╨ùA╨ƒ╨ÿC╨ÿ ╨ÿ╨ù BX. H.╨ö. * 22620000 *********************************************************************** 22630000 * RETURN CODE = 0 - OK * 22640000 * RETURN CODE = 2 - KOHE╨ª H.╨ö. * 22650000 * RETURN CODE = 4 - I/O ERROR * 22660000 * RETURN CODE = 6 - HEPAC╨ƒO╨ùHAHHA╨» ERROR * 22670000 *********************************************************************** 22680000 GTREC SAVE 22690000 USING GTREC,BASE 22700000 LR BASE,R14 22710000 XC $GET$L(2),$GET$L 22720000 * 22730000 GTR030 MVC TCATDDI(4),FILEDEST 22740000 DFHTD TYPE=GET,IOERROR=GTR300,QUEZERO=GTR200,NORESP=GTR050 22750000 LA R14,6 RC = 6 22760000 B GTRRET 22770000 * 22780000 GTR050 L TDIABAR,TCATDAA 22790000 TM FILSTAT,X'C0' INTRA ? 22800000 BNO GTR070 HET 22810000 LH R2,TDIAIRL 22820000 SH R2,=H'4' - L'RDW 22830000 LA R1,TDIADBA 22840000 B GTR100 22850000 * 22860000 GTR070 TM FILSTAT,X'08' 22870000 BNZ GTR090 HE V 22880000 TM FILSTAT,X'04' 22890000 BNO GTR090 HE V 22900000 LH R2,0(TDIABAR) 22910000 SH R2,=H'4' - L'RDW 22920000 LA R1,4(TDIABAR) 22930000 B GTR100 22940000 * 22950000 GTR090 LH R2,F#REC 22960000 LR R1,TDIABAR 22970000 * 22980000 GTR100 STH R2,$GET$L ╨ö╨¢╨ÿHA 22990000 ST R1,$FMA A╨öPEC HA╨ºA╨¢A ╨öAHH╨½X 23000000 XR R14,R14 RC = 0 23010000 B GTRRET 23020000 GTR200 XR R1,R1 23030000 ST R1,$FMA 23040000 LA R14,2 RC = 2 23050000 B GTRRET 23060000 GTR300 LA R14,4 RC = 4 23070000 GTRRET RETURN 23080000 *********************************************************************** 23090000 LTORG 23100000 DROP BASE 23110000 *********************************************************************** 23120000 * ╨ƒO╨ö╨ƒPO╨ôPAMMA O╨æPA╨æOTK╨ÿ ╨ùA╨ƒPOCA HA ╨ƒOC╨½╨¢K╨ú ╨ƒAKETA * 23130000 *********************************************************************** 23140000 * RETURN CODE = 0 - OK * 23150000 * RETURN CODE = 2 - ERROR HOST PROGRAMM (H╨ú╨ûEH ERROR ╨ƒAKET) * 23160000 *********************************************************************** 23170000 * ╨öAHH╨½E ╨ö╨¢╨» ╨ƒAKETA ╨ú╨ûE ╨öO╨¢╨ûH╨½ HAXO╨ö╨ÿT╨¼C╨» B TIOADBA+3 ($SMA) * 23180000 *********************************************************************** 23190000 SPACK SAVE 23200000 USING SPACK,BASE 23210000 LR BASE,R14 23220000 XR R15,R15 KOHTPO╨¢╨¼HA╨» C╨úMMA 23230000 LH R4,$SDAT$L ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú ╨öAHH╨½X 23240000 LA R4,3(R4) +NUM +TYPE +CHECK 23250000 CH R4,PACKET ╨ƒPOBEP╨ÿT╨¼ MAKC╨ÿMA╨¢╨¼H╨ú╨« ╨ö╨¢╨ÿH╨ú ╨öAHH╨½X 23260000 BH SPACK700 ERROR HOST PROGRAMM 23270000 L TIOABAR,$SMA 23280000 LA R1,TIOADBA A╨öPEC O╨æ╨¢ACT╨ÿ B╨½BO╨öA 23290000 XR R5,R5 23300000 XR R15,R15 23310000 * ╨ñOPM╨ÿPOBAH╨ÿE ╨ƒAKETA 23320000 LA R4,35 X'20' +NUM +TYPE +CHECK 23330000 AH R4,$SDAT$L ╨ƒP╨ÿ╨æAB╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú ╨öAHH╨½X 23340000 * ╨ùA╨ƒ╨ÿC╨¼ ╨ö╨¢╨ÿH╨½ ╨ƒAKETA 23350000 STC R4,0(R5,R1) ╨ùA╨ƒ╨ÿCAT╨¼ ╨ö╨¢╨ÿH╨ú ╨ƒAKETA 23360000 LA R5,1(R5) 23370000 AR R15,R4 ╨ƒP╨ÿ╨æAB╨ÿT╨¼ K KOHTPO╨¢╨¼HO╨Ö C╨úMME 23380000 CLC $N$OLD(2),=H'0' CPABH╨ÿT╨¼ HOMEP ╨ƒAKETA C H╨ú╨¢EM 23390000 BL SPACK690 ERROR HOST PROGRAMM 23400000 CLC $N$OLD(2),=H'64' HE MO╨ûET ╨æ╨½T╨¼ ╨æO╨¢╨¼╨¿E 64 23410000 BH SPACK690 ERROR HOST PROGRAMM 23420000 LA R4,32 X'20' 23430000 AH R4,$N$OLD ╨ƒP╨ÿ╨æAB╨ÿT╨¼ HOMEP ╨ƒAKETA 23440000 * ╨ùA╨ƒ╨ÿC╨¼ HOMEPA ╨ƒAKETA 23450000 STC R4,0(R5,R1) ╨ùA╨ƒ╨ÿCAT╨¼ HOMEP ╨ƒAKETA 23460000 LA R5,1(R5) 23470000 AR R15,R4 ╨ƒP╨ÿ╨æAB╨ÿT╨¼ K KC 23480000 CLI $S$CUR,AA ASCII 'A', HE MO╨ûET ╨æ╨½T╨¼ MEH╨¼╨¿E 23490000 BL SPACK680 ERROR HOST PROGRAMM 23500000 CLI $S$CUR,AZ ASCII 'Z', ╨æO╨¢╨¼╨¿E ╨æ╨½T╨¼ HE ╨öO╨¢╨ûEH 23510000 BH SPACK680 ERROR HOST PROGRAMM 23520000 XR R2,R2 O╨º╨ÿCT╨ÿT╨¼ ╨ö╨¢╨» $S$CUR 23530000 IC R2,$S$CUR ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ T╨ÿ╨ƒ ╨ƒAKETA 23540000 AR R15,R2 ╨ƒP╨ÿ╨æAB╨ÿT╨¼ K KC 23550000 CLI $R$CUR,AN ╨ƒP╨ÿH╨»╨¢╨ÿ NAK ? 23560000 BE SPACK030 ╨öA 23570000 CLI $S$CUR,AN ╨ƒOC╨½╨¢AEM NAK ? 23580000 BNE SPACK050 HET 23590000 SPACK030 LR R0,R1 23600000 LH R1,$RETRY 23610000 LA R1,1(R1) 23620000 STH R1,$RETRY 23630000 LR R1,R0 23640000 SPACK050 EQU * 23650000 * ╨ùA╨ƒ╨ÿC╨¼ T╨ÿ╨ƒA ╨ƒAKETA 23660000 STC R2,0(R5,R1) ╨ùA╨ƒ╨ÿCAT╨¼ T╨ÿ╨ƒ ╨ƒAKETA 23670000 LA R5,1(R5) 23680000 LH R3,$SDAT$L ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú ╨öAHH╨½X 23690000 LTR R3,R3 ╨ƒPOBEP╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú 23700000 BZ SPACK200 EC╨¢╨ÿ HO╨¢╨¼, O╨æPA╨æOTKA HE TPE╨æ╨úETC╨» 23710000 * 23720000 SPACK100 IC R2,0(R5,R1) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ O╨ºEPE╨öHO╨Ö C╨ÿMBO╨¢ 23730000 AR R15,R2 ╨ƒP╨ÿ╨æAB╨ÿT╨¼ K KC 23740000 LA R5,1(,R5) ╨ƒEPEMECT╨ÿT╨¼ ╨ÿH╨öEKC 23750000 BCT R3,SPACK100 ╨ÿ O╨æPA╨æOTAT╨¼ C╨¢E╨ö. C╨ÿMBO╨¢ 23760000 * 23770000 SPACK200 ST R15,DBLWRK CKOPO ╨ƒOTPE╨æ╨úETC╨» 23780000 N R15,=X'000000C0' R15 MOD 192 23790000 M R14,=F'1' ╨ƒEPEHECT╨ÿ ╨ùHAKOB╨½╨Ö ╨æ╨ÿT 23800000 D R14,=F'64' R15 DIV 64 23810000 A R15,DBLWRK ╨ƒP╨ÿ╨æAB╨ÿT╨¼ ╨ÿCX. ╨ùHA╨º. KC 23820000 N R15,=X'0000003F' R15 MOD 64 23830000 LA R15,32(,R15) ╨ƒP╨ÿ╨æAB╨ÿT╨¼ ╨ƒPO╨æE╨¢ 23840000 STC R15,0(R5,R1) ╨ùA╨ƒ╨ÿCAT╨¼ KC ╨ƒOC╨¢E ╨öAHH╨½X 23850000 L R14,A#TRT#SO A╨öPEC B╨½XO╨öHO╨Ö TA╨æ╨¢╨ÿ╨ª╨½ 23860000 EX R5,SPACK600 ╨ƒEPE╨öA╨ºA ╨æ╨ú╨öET B KO╨öE ╨öKO╨ÿ 23870000 LA R5,1(,R5) ╨ƒEPEMECT╨ÿT╨¼ ╨ÿH╨öEKC (+ L'CHECK) 23880000 * 23890000 TM PRMSTAT,X'0C' DEBUG OFF ? 23900000 BZ SPACK300 ╨öA 23910000 *********DEBUG ********* 23920000 L TDOABAR,$DMA 23930000 MVC TDOADBA(11),=C'SEND PACKET' 23940000 MVC TDOAVRL(2),=H'15' 23950000 XC TDOAVRL+2(2),TDOAVRL+2 23960000 MVC TCATDDI(4),DBGDEST 23970000 LA R14,TDOAVRL 23980000 ST R14,TCATDAA 23990000 DFHTD TYPE=PUT,NORESP=SPDB01 24000000 NI PRMSTAT,X'FF'-X'0C' C╨æPOC╨ÿT╨¼ ╨ƒP╨ÿ╨ùHAK DEBUG 24010000 B SPDB03 24020000 * 24030000 SPACK620 MVC TDOADBA(0),0(R1) 24040000 * 24050000 SPDB01 EQU * 24060000 LA R2,4(R5) +RDW 24070000 STH R2,TDOAVRL 24080000 XC TDOAVRL+2(2),TDOAVRL+2 24090000 SH R2,=H'5' B╨½╨ºECT╨¼ 1 ╨ö╨¢╨» MVC 24100000 EX R2,SPACK620 ╨ùA╨ƒ╨ÿCAT╨¼ ╨öAHH╨½E 24110000 LA R14,TDOAVRL 24120000 ST R14,TCATDAA 24130000 DFHTD TYPE=PUT,NORESP=SPDB03 24140000 NI PRMSTAT,X'FF'-X'0C' C╨æPOC╨ÿT╨¼ ╨ƒP╨ÿ╨ùHAK DEBUG 24150000 SPDB03 EQU * 24160000 *********DEBUG ********* 24170000 SPACK300 EQU * 24180000 L TIOABAR,$SMA 24190000 ST TIOABAR,TCTTEDA ╨ùA╨ƒ╨ÿCAT╨¼ B TCTTE 24200000 STH R5,TIOATDL ╨ùA╨ƒ╨ÿCAT╨¼ ╨ö╨¢╨ÿH╨ú TIOA 24210000 DFHTC TYPE=(PUT,SAVE) B╨½BECT╨ÿ ╨ƒAKET 24220000 L R14,A#TRT#SI A╨öPEC TRT ╨ÿ╨ù ╨¢╨ÿH╨ÿ╨ÿ 24230000 BCTR R5,0 24240000 EX R5,SPACK600 BEPH╨úT╨¼ B KO╨ö ASCII 24250000 XR R14,R14 RC = 0 24260000 B SPRET ╨ÿ BO╨ùBPAT 24270000 SPACK680 MVI #ERROR,E$HSTTYP 24280000 B SPACK750 24290000 SPACK690 MVI #ERROR,E$HSTNUM 24300000 B SPACK750 24310000 SPACK700 MVI #ERROR,E$HSTLEN HEBEPHA╨» ╨ö╨¢╨ÿHA ╨ƒAKETA 24320000 SPACK750 MVI $STATE,C'A' COCTO╨»H╨ÿE ABORT 24330000 LA R14,2 RC = 2 24340000 B SPRET ╨ÿ BO╨ùBPAT 24350000 SPACK600 TR 0(0,R1),0(R14) ╨ƒEPE╨öA╨ºA ╨æ╨ú╨öET B KO╨öE ╨öKO╨ÿ 24360000 SPRET RETURN 24370000 *********************************************************************** 24380000 LTORG 24390000 DROP BASE 24400000 *********************************************************************** 24410000 * ╨ƒO╨ö╨ƒPO╨ôPAMMA ╨ºTEH╨ÿ╨» ╨ƒAKETOB OT ╨ƒAPTHEPA * 24420000 *********************************************************************** 24430000 * RETURN CODE = 0 - OK * 24440000 * RETURN CODE = 2 - BAD PACKET OT ╨ƒAPTHEPA (H╨ú╨ûEH NAK) * 24450000 *********************************************************************** 24460000 RPACK SAVE 24470000 USING RPACK,BASE 24480000 LR BASE,R14 24490000 * 24500000 L R1,$RMA 24510000 LTR R1,R1 ╨æ╨½╨¢╨ÿ ╨ú╨ûE ╨ƒAKET╨½ ? 24520000 BZ RPACK010 HET 24530000 ST R1,TCASCSA 24540000 DFHSC TYPE=FREEMAIN OCBO╨æO╨ö╨ÿT╨¼ ╨ƒPE╨ö╨½╨ö╨ú╨⌐╨ú╨« TIOA 24550000 XC $RMA(4),$RMA 24560000 * 24570000 RPACK010 DFHTC TYPE=(GET,SAVE) ╨º╨ÿTAT╨¼ ╨öAHH╨½E C TEPM╨ÿHA╨¢A 24580000 L TIOABAR,TCTTEDA 24590000 ST TIOABAR,$RMA 24600000 LH R2,TIOATDL ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú TIOA 24610000 LH R1,PACKET ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ MAX ╨ö╨¢╨ÿH╨ú ╨ƒAKETA 24620000 LA R1,5(R1) MAXLEN +MARK +LEN +EOL +2 HA BC╨»K╨ÿ╨Ö 24630000 CR R2,R1 ╨ö╨¢╨ÿHA TIOA > MAX ╨ö╨¢╨ÿH╨½ ╨ƒAKETA ? 24640000 BH RPACK700 ERROR PACKET LENGHT 24650000 LTR R2,R2 ECT╨¼ ╨öAHH╨½E B TIOA ? 24660000 BZ RPACK700 ERROR PACKET LENGHT 24670000 LA R1,TIOADBA A╨öPEC ╨ƒP╨ÿ╨¿E╨ö╨¿╨ÿX ╨öAHH╨½X 24680000 * 24690000 TM PRMSTAT,X'0C' DEBUG OFF ? 24700000 BZ RPACK200 ╨öA 24710000 *********DEBUG ********* 24720000 L TDOABAR,$DMA LOAD A╨öPECA ╨ƒAM╨»T╨ÿ DEBUG 24730000 MVC TDOADBA(10),=C'REC PACKET' 24740000 MVC TDOAVRL(2),=H'14' 24750000 XC TDOAVRL+2(2),TDOAVRL+2 24760000 MVC TCATDDI(4),DBGDEST 24770000 LA R14,TDOAVRL 24780000 ST R14,TCATDAA 24790000 DFHTD TYPE=PUT,NORESP=RPDB01 24800000 NI PRMSTAT,X'FF'-X'0C' C╨æPOC╨ÿT╨¼ ╨ƒP╨ÿ╨ùHAK DEBUG 24810000 B RPDB03 24820000 * 24830000 RPACK600 MVC TDOADBA(0),0(R1) 24840000 * 24850000 RPDB01 EQU * 24860000 LA R5,4(R2) + RDW 24870000 STH R5,TDOAVRL 24880000 XC TDOAVRL+2(2),TDOAVRL+2 24890000 SH R5,=H'5' B╨½╨ºECT╨¼ 1 ╨ö╨¢╨» MVC 24900000 EX R5,RPACK600 ╨ùA╨ƒ╨ÿCAT╨¼ ╨öAHH╨½E 24910000 LA R14,TDOAVRL 24920000 ST R14,TCATDAA 24930000 DFHTD TYPE=PUT,NORESP=RPDB03 24940000 NI PRMSTAT,X'FF'-X'0C' C╨æPOC╨ÿT╨¼ ╨ƒP╨ÿ╨ùHAK DEBUG 24950000 * 24960000 RPDB03 EQU * 24970000 *********DEBUG ********* 24980000 RPACK200 L R14,A#TRT#SI A╨öPEC BXO╨öHO╨Ö TA╨æ╨¢╨ÿ╨ª╨½ ╨ƒEPEKO╨ö╨ÿPOBK╨ÿ 24990000 LR R5,R2 25000000 BCTR R5,0 25010000 EX R5,RPACK640 25020000 XR R2,R2 ╨ÿH╨öEKCH╨½╨Ö ╨ö╨¢╨» 25030000 LR R5,R1 A╨öPEC HA╨ºA╨¢A ╨ƒAKETA 25040000 B RPACK220 25050000 * 25060000 RPACK640 TR 0(0,R1),0(R14) ╨ƒEPEKO╨ö╨ÿPOBAT╨¼ B ASCII 25070000 * 25080000 RPACK210 LA R2,1(,R2) ╨ƒEPEMECT╨ÿT╨¼ ╨ÿH╨öEKC 25090000 RPACK220 XR R15,R15 KOHTPO╨¢╨¼HA╨» C╨úMMA 25100000 LA R5,0(R2,R1) A╨öPEC TEK╨ú╨⌐E╨ôO C╨ÿMBO╨¢A 25110000 CLI 0(R5),X'20' S O H ? 25120000 BL RPACK210 EC╨¢╨ÿ SOH, TO BCE HA╨ºAT╨¼ CHA╨ºA╨¢A 25130000 * 25140000 CLI 0(R5),X'23' ╨ö╨¢╨ÿHA ╨öO╨¢╨ûHA ╨æ╨½T╨¼ HE MEHEE 3 25150000 BL RPACK700 EC╨¢╨ÿ >=, TO BCE B ╨ƒOP╨»╨öKE 25160000 IC R15,0(,R5) HA╨ºAT╨¼ ╨ƒOC╨ºET KC 25170000 LR R5,R15 ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú ╨ƒAKETA 25180000 * ====================== 25190000 SH R5,=H'35' X'20' +NUM +TYPE +CHECK 25200000 STH R5,$RDAT$L ╨ùA╨ƒ╨ÿCAT╨¼ ╨ö╨¢╨ÿH╨ú ╨ƒP╨ÿH╨»T╨½X ╨öAHH╨½X 25210000 LA R2,1(,R2) ╨ƒEPEMECT╨ÿT╨¼ ╨ÿH╨öEKC 25220000 IC R5,0(R2,R1) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ HOMEP ╨ƒAKETA 25230000 * ====================== 25240000 XR R0,R0 ╨ö╨¢╨» ╨ùA╨ôP╨ú╨ùK╨ÿ SOH 25250000 LA R0,X'20' ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ SOH 25260000 CR R5,R0 S O H ? 25270000 BL RPACK210 EC╨¢╨ÿ SOH, TO BCE HA╨ºAT╨¼ CHA╨ºA╨¢A 25280000 * 25290000 AR R15,R5 ╨ƒP╨ÿ╨æAB╨ÿT╨¼ K KC 25300000 SH R5,=H'32' OTH╨»T╨¼ ╨ƒPO╨æE╨¢ 25310000 STH R5,RPACK800 ╨ùA╨ƒ╨ÿCAT╨¼ HOMEP ╨ƒAKETA 25320000 LA R2,1(,R2) ╨ƒEPEMECT╨ÿT╨¼ ╨ÿH╨öEKC 25330000 IC R5,0(R2,R1) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ T╨ÿ╨ƒ ╨ƒAKETA 25340000 * ==================== 25350000 CR R5,R0 S O H ? 25360000 BL RPACK210 EC╨¢╨ÿ SOH, TO BCE HA╨ºAT╨¼ CHA╨ºA╨¢A 25370000 * 25380000 AR R15,R5 ╨ƒP╨ÿ╨æAB╨ÿT╨¼ K KC 25390000 STC R5,RPACK810 ╨ùA╨ƒ╨ÿCAT╨¼ T╨ÿ╨ƒ ╨ƒAKETA 25400000 LA R2,1(,R2) ╨ƒEPEMECT╨ÿT╨¼ ╨ÿH╨öEKC 25410000 * O╨æPA╨æOTKA ╨öAHH╨½X ╨ƒAKETA 25420000 LA R3,0(R2,R1) ╨ÿH╨öEKCH╨½╨Ö ╨ö╨¢╨» RDAT 25430000 ST R3,$DAT$A COXPAH╨ÿT╨¼ A╨öPEC ╨öAHH╨½X 25440000 LH R4,$RDAT$L ╨ö╨¢╨ÿHA ╨öAHH╨½X B ╨ƒAKETE 25450000 LTR R4,R4 ECT╨¼ ╨öAHH╨½E ? 25460000 BZ RPACK320 EC╨¢╨ÿ HET, HE O╨æPA╨æAT╨½BAT╨¼ 25470000 * 25480000 RPACK300 IC R5,0(R2,R1) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ C╨ÿMBO╨¢ 25490000 CR R5,R0 S O H ? 25500000 BL RPACK210 EC╨¢╨ÿ SOH, TO BCE HA╨ºAT╨¼ CHA╨ºA╨¢A 25510000 AR R15,R5 ╨ƒP╨ÿ╨æAB╨ÿT╨¼ K KC 25520000 LA R2,1(,R2) ╨ƒEPEMECT╨ÿT╨¼ ╨ÿH╨öEKC 25530000 BCT R4,RPACK300 ╨ÿ O╨æPA╨æOTAT╨¼ C╨¢E╨ö╨ú╨«╨⌐╨ÿ╨Ö C╨ÿMBO╨¢ 25540000 * 25550000 RPACK320 XR R5,R5 O╨º╨ÿCT╨ÿT╨¼ 25560000 IC R5,0(R2,R1) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ CHECK 25570000 CR R5,R0 S O H ? 25580000 BL RPACK210 EC╨¢╨ÿ SOH, TO BCE HA╨ºAT╨¼ CHA╨ºA╨¢A 25590000 ST R15,DBLWRK CKOPO ╨ƒOTPE╨æ╨úETC╨» 25600000 N R15,=X'000000C0' R15 MOD 192 25610000 M R14,=F'1' ╨ƒEPEHECT╨ÿ ╨ùHAKOB╨½╨Ö ╨æ╨ÿT 25620000 D R14,=F'64' R15 DIV 64 25630000 A R15,DBLWRK ╨ƒP╨ÿ╨æAB╨ÿT╨¼ KC 25640000 N R15,=X'0000003F' R15 MOD 64 25650000 LA R15,32(,15) ╨ƒP╨ÿ╨æAB╨ÿT╨¼ ╨ƒPO╨æE╨¢ 25660000 CR R15,R5 PABH╨½ KOHTPO╨¢╨¼H╨½E C╨úMM╨½ 25670000 BE RPACK720 EC╨¢╨ÿ ╨öA, HOPMA╨¢╨¼H╨½╨Ö B╨½XO╨ö 25680000 MVI #ERROR,E$CHECK O╨¿╨ÿ╨æKA B KOHTPO╨¢╨¼HO╨Ö C╨úMME 25690000 B RPACK710 25700000 RPACK700 MVI #ERROR,E$LENG 25710000 RPACK710 LA R14,2 RC = 2 25720000 MVI $R$CUR,AN ╨ùA╨ƒ╨ÿCAT╨¼ NAK 25730000 B RPACKRET 25740000 RPACK800 DS H HOMEP ╨ƒAKETA 25750000 RPACK810 DS H T╨ÿ╨ƒ ╨ƒAKETA 25760000 RPACK720 MVC $N$CUR(2),RPACK800 25770000 MVC $R$CUR(1),RPACK810 25780000 XR R14,R14 RC = 0 25790000 RPACKRET RETURN 25800000 *********************************************************************** 25810000 LTORG 25820000 DROP BASE 25830000 *********************************************************************** 25840000 * ╨ƒO╨ö╨ƒPO╨ôPAMMA O╨æPA╨æOTK╨ÿ KOMAH╨ö╨½ RECEIVE * 25850000 *********************************************************************** 25860000 * RETURN CODE = 0 - OK * 25870000 *********************************************************************** 25880000 RECEIVE SAVE 25890000 USING RECEIVE,BASE 25900000 LR BASE,R14 25910000 MVC PACKAGE+1(18),=C'RECEIVE WAITING...' 25920000 MVI PACKAGE,18 25930000 CALL WRS B╨½╨öAT╨¼ COO╨æ╨⌐EH╨ÿE 25940000 XC $PUT$L(2),$PUT$L TEK╨ú╨⌐A╨» ╨ƒO╨ù╨ÿ╨ª╨ÿ╨» B ╨ùA╨ƒ╨ÿC╨ÿ - 0 25950000 XC $RETRY(2),$RETRY ╨º╨ÿC╨¢O ╨ƒOBTOPOB ╨ƒEPE╨öA╨º╨ÿ => 0 25960000 XC $N$OLD(2),$N$OLD HOMEP ╨ƒAKETA => 0 25970000 MVI $STATE,C'R' ╨û╨öAT╨¼ SEND_INIT 25980000 *********************************************************************** 25990000 * OCHOBHO╨Ö ╨ª╨ÿK╨¢ O╨æPA╨æOTK╨ÿ RECEIVE * 26000000 *********************************************************************** 26010000 RLOOP CLI $STATE,C'D' D A T A ? 26020000 BNE RLOOP1 26030000 CALL RDATA 26040000 BRTORC RLOOP,REST=RLOOPERR 26050000 RLOOP1 CLI $STATE,C'F' FILE_HEADER ? 26060000 BNE RLOOP2 26070000 CALL RFILE 26080000 BRTORC RLOOP,REST=RLOOPERR 26090000 RLOOP2 CLI $STATE,C'R' SEND_INIT ? 26100000 BNE RLOOP3 26110000 CALL RINIT 26120000 BRTORC RLOOP,REST=RLOOPERR 26130000 RLOOP3 CLI $STATE,C'C' COMPLETE ? 26140000 BNE RLOOP4 26150000 B RECRET 26160000 RLOOP4 CLI $STATE,C'A' ABORT ? 26170000 BNE RLOOP5 26180000 RLOOPERR CALL RABORT 26190000 B RECRET 26200000 RLOOP5 MVI #ERROR,E$STATE HEPAC╨ƒO╨ùHAHHOE COCTO╨»H╨ÿE 26210000 CALL RABORT 26220000 * ╨ùABEP╨¿EH╨ÿE ╨ƒP╨ÿEMA ╨ñA╨Ö╨¢A * 26230000 RECRET XR R14,R14 H╨ú╨¢EBO╨Ö KO╨ö BO╨ùBPATA 26240000 RETURN 26250000 *********************************************************************** 26260000 LTORG 26270000 DROP BASE 26280000 *********************************************************************** 26290000 * A B O R T * 26300000 *********************************************************************** 26310000 * RETURN CODE = 0 - OK * 26320000 *********************************************************************** 26330000 RABORT SAVE 26340000 USING RABORT,BASE 26350000 LR BASE,R14 26360000 CLI #ERROR,E$ERR O╨æ╨¢OMA╨¢C╨» ╨ƒAPTHEP ? 26370000 BE RAB100 EC╨¢╨ÿ ╨öA, ╨ƒAKET HE ╨ƒOC╨½╨¢AT╨¼ 26380000 MVI $S$CUR,AE T╨ÿ╨ƒ ╨ƒAKETA - ERROR 26390000 MVC $SDAT$L(2),=H'30' ╨ö╨¢╨ÿHA COO╨æ╨¿EH╨ÿ╨» 26400000 MVC $N$OLD(2),$N$CUR C╨ÿHXPOH╨ÿ╨ù╨ÿPOBAT╨¼ HOMEPA ╨ƒAKETOB 26410000 XR R2,R2 26420000 IC R2,#ERROR ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ HOMEP O╨¿╨ÿ╨æK╨ÿ 26430000 MH R2,=H'30' ╨úMHO╨û╨ÿT╨¼ HA ╨ö╨¢╨ÿH╨ú COO╨æ╨⌐EH╨ÿ╨» 26440000 L R3,ERRTBL#A A╨öPEC TA╨æ╨¢╨ÿ╨ª╨½ ERROR COO╨æ╨⌐EH╨ÿ╨Ö 26450000 LA R3,0(R3,R2) ╨ƒO╨¢╨ú╨º╨ÿT╨¼ A╨öPEC COO╨æ╨⌐EH╨ÿ╨» 26460000 L TIOABAR,$SMA 26470000 LA R1,TIOADBA 26480000 LA R1,3(R1) 26490000 MVC 0(30,R1),0(R3) ╨ùA╨ƒ╨ÿCAT╨¼ TEKCT COO╨æ╨⌐EH╨ÿ╨» 26500000 L R2,A#TRT#EA A╨öPEC TA╨æ╨¢╨ÿ╨ª╨½ ╨ƒEPEKO╨ö╨ÿPOBK╨ÿ B ASCII 26510000 TR 0(30,R1),0(R2) ╨ƒEPEBECT╨ÿ B ASCII 26520000 CALL SPACK 26530000 RAB100 XR R14,R14 RC = 0 26540000 RETURN 26550000 *********************************************************************** 26560000 LTORG 26570000 DROP BASE 26580000 *********************************************************************** 26590000 * O╨æPA╨æOTKA SEND_INIT * 26600000 *********************************************************************** 26610000 * RETURN CODE = 0 - OK * 26620000 * RETURN CODE = 2 - ERROR (H╨ú╨ûEH ERROR ╨ƒAKET) * 26630000 *********************************************************************** 26640000 RINIT SAVE 26650000 USING RINIT,BASE 26660000 LR BASE,R14 26670000 CALL RPACK ╨º╨ÿTAT╨¼ ╨ƒAKET OT ╨ƒAPTHEPA 26680000 BRTORC RINIT010,REST=RINIT600 26690000 RINIT010 CLI $R$CUR,AS SEND_INIT ? 26700000 BE RINIT015 26710000 CLI $R$CUR,AE ERROR ? 26720000 BE RINIT990 26730000 BNE RINIT600 ╨ƒOC╨¢AT╨¼ NAK 26740000 * O╨æPA╨æOTKA ╨ƒO╨¢╨» MAXLEN 26750000 RINIT015 XR R1,R1 26760000 XR R3,R3 26770000 L R2,$DAT$A 26780000 IC R1,0(R3,R2) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú ╨ƒAKETA 26790000 SH R1,=H'32' OTH╨»T╨¼ ╨ƒPO╨æE╨¢ 26800000 LTR R1,R1 26810000 BNZ RINIT020 26820000 LH R1,PACKET ╨ùA╨ƒPO╨¿EHA ╨ö╨¢╨ÿHA ╨ƒO ╨úMO╨¢╨ºAH╨ÿ╨« 26830000 B RINIT030 26840000 * 26850000 RINIT020 EQU * 26860000 CH R1,=H'94' CPABH╨ÿT╨¼ C MAKC╨ÿMA╨¢╨¼HO╨Ö ╨ö╨¢╨ÿHO╨Ö 26870000 BNH RINIT030 EC╨¢╨ÿ <=, TO BCE B ╨ƒOP╨»╨öKE 26880000 B RINIT700 ERROR INIT PARM 26890000 * 26900000 RINIT030 STH R1,PACKET ╨ùA╨ƒ╨ÿCAT╨¼ MAKC. ╨ö╨¢╨ÿH╨ú ╨ƒAKETOB 26910000 LA R3,4(R3) 26920000 * O╨æPA╨æOTKA ╨ƒO╨¢╨» EOL 26930000 CH R3,$RDAT$L ECT╨¼ E╨⌐E ╨ƒAPAMETP╨½ ? 26940000 BNH RINIT500 HET 26950000 IC R1,0(R3,R2) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ EOL 26960000 SH R1,=H'32' B╨½╨ºECT╨¼ ╨ƒPO╨æE╨¢ 26970000 CH R1,=H'32' 26980000 BNL RINIT700 26990000 STC R1,S#EOT ╨ùA╨ƒ╨ÿCAT╨¼ EOL 27000000 LA R3,1(R3) 27010000 * O╨æPA╨æOTKA ╨ƒO╨¢╨» QUOTE 27020000 CH R3,$RDAT$L ECT╨¼ E╨⌐E ╨ƒAPAMETP╨½ ? 27030000 BNH RINIT500 HET 27040000 IC R1,0(R3,R2) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ QUOTE 27050000 CH R1,=H'32' 27060000 BNH RINIT700 ERROR INIT PARM 27070000 CH R1,=H'126' 27080000 BH RINIT700 ERROR INIT PARM 27090000 CH R1,=H'62' 27100000 BNH RINIT110 27110000 CH R1,=H'96' 27120000 BL RINIT700 ERROR INIT PARM 27130000 RINIT110 STC R1,QUOTE ╨ùA╨ƒ╨ÿCAT╨¼ QUOTE 27140000 LA R3,1(R3) 27150000 * O╨æPA╨æOTKA ╨ƒO╨¢╨» PREF 27160000 CH R3,$RDAT$L ECT╨¼ E╨⌐E ╨ƒAPAMETP╨½ ? 27170000 BNH RINIT500 HET 27180000 LA R1,0(R3,R2) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ QUOTE 27190000 CLC QUOTE(1),0(R1) QUOTE = PREF ? 27200000 BE RINIT700 ERROR INIT PARM 27210000 IC R1,0(R3,R2) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ PREF 27220000 CH R1,=H'32' 27230000 BNH RINIT700 ERROR INIT PARM 27240000 CH R1,=H'126' 27250000 BH RINIT700 ERROR INIT PARM 27260000 CH R1,=H'62' 27270000 BNH RINIT210 27280000 CH R1,=H'96' 27290000 BL RINIT700 ERROR INIT PARM 27300000 RINIT210 STC R1,PREF ╨ùA╨ƒ╨ÿCAT╨¼ PREF 27310000 CLI $RDAT$L+1,7 ECT╨¼ PREF ? 27320000 LA R3,1(R3) 27330000 * O╨æPA╨æOTKA ╨ƒO╨¢╨» CHECK 27340000 CH R3,$RDAT$L ECT╨¼ E╨⌐E ╨ƒAPAMETP╨½ ? 27350000 BNH RINIT500 HET 27360000 RINIT500 MVC $N$OLD,$N$CUR C╨ÿHXPOH╨ÿ╨ù╨ÿPOBAT╨¼ HOMEPA ╨ƒAKETOB 27370000 MVI $S$CUR,AY T╨ÿ╨ƒ ╨ƒAKETA - ACK 27380000 MVC $SDAT$L(2),=H'7' ╨ö╨¢╨ÿHA ╨öAHH╨½X = 7 27390000 * 27400000 L TIOABAR,$SMA 27410000 LA R1,TIOADBA A╨öPEC HA╨ºA╨¢A ╨ƒAKETA 27420000 LA R1,3(R1) A╨öPEC ╨öAHH╨½X B ╨ƒAKETE 27430000 * 27440000 LA R15,32 ╨ƒPO╨æE╨¢ ( X'20' ) 27450000 LH R2,PACKET ╨ö╨¢╨ÿHA ╨ƒP╨ÿH╨ÿMAEM╨½X ╨ƒAKETOB 27460000 AR R2,R15 ╨ƒP╨ÿ╨æAB╨ÿT╨¼ ╨ƒPO╨æE╨¢ 27470000 * ╨ùA╨ƒ╨ÿCAT╨¼ ╨ö╨¢╨ÿH╨ú ╨ƒAKETA 27480000 STC R2,0(R1) ╨ùA╨ƒ╨ÿCAT╨¼ ╨ö╨¢╨ÿH╨ú 27490000 MVC 1(3,R1),=X'282020' TA╨ÖMA╨úT, NPAD, PADC 27500000 IC R2,R#EOT EOL 27510000 AR R2,R15 ╨ƒP╨ÿ╨æAB╨ÿT╨¼ ╨ƒPO╨æE╨¢ 27520000 STC R2,4(R1) 27530000 MVC 5(1,R1),QUOTE ╨ùA╨ƒ╨ÿCAT╨¼ QUOTE 27540000 MVC 6(1,R1),PREF ╨ùA╨ƒ╨ÿCAT╨¼ PREF 27550000 CALL SPACK ╨ƒOC╨¢AT╨¼ ACK 27560000 BRTORC RINIT550,REST=RINIT700 27570000 RINIT550 MVI $STATE,C'F' ╨ƒEPEXO╨ö B COCTO╨»H╨ÿE FILE_HEADER 27580000 LH R3,$N$OLD ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ HOMEP ╨ƒAKETA 27590000 LA R3,1(,R3) ╨úBE╨¢╨ÿ╨º╨ÿT╨¼ HA 1 27600000 N R3,=X'0000003F' R3 MOD 63 27610000 STH R3,$N$OLD ╨ùA╨ƒ╨ÿCAT╨¼ HOMEP O╨æPATHO 27620000 XR R14,R14 RC = 0 27630000 B RINIRET ╨ÿ ╨û╨öAT╨¼ FILE_HEADER 27640000 RINIT600 EQU * 27650000 CLC $RETRY(2),RETRY ╨ƒPEB╨½╨¿EH ╨¢╨ÿM╨ÿT HA ╨ƒOBTOP ? 27660000 BH RINIT700 ╨öA 27670000 MVI $S$CUR,AN T╨ÿ╨ƒ ╨ƒAKETA - NAK 27680000 XC $SDAT$L(2),$SDAT$L ╨ö╨¢╨ÿHA ╨öAHH╨½X = 0 27690000 CALL SPACK ╨ƒOC╨¢AT╨¼ NAK 27700000 XR R14,R14 RC = 0 27710000 B RINIRET ╨ÿ ╨û╨öAT╨¼ C╨¢E╨ö. ╨ƒAKET 27720000 RINIT700 EQU * 27730000 MVI $STATE,C'A' ╨ƒEPEXO╨ö B COCTO╨»H╨ÿE ABORT 27740000 LA R14,2 RC = 2 27750000 B RINIRET ╨ƒOC╨¢AT╨¼ ERROR ╨ÿ ╨ùABEP╨¿╨ÿT╨¼ RECEIVE 27760000 RINIT990 MVI #ERROR,E$ERR ╨ƒP╨ÿ╨¿E╨¢ ERROR ╨ƒAKET 27770000 MVI $STATE,C'A' ╨ƒEPEXO╨ö B COCTO╨»H╨ÿE ABORT 27780000 LA R14,2 RC = 2 27790000 B RINIRET ╨ƒOC╨¢AT╨¼ ERROR ╨ÿ ╨ùABEP╨¿╨ÿT╨¼ RECEIVE 27800000 RINIRET RETURN 27810000 *********************************************************************** 27820000 LTORG 27830000 DROP BASE 27840000 *********************************************************************** 27850000 * O╨æPA╨æOTKA FILE_HEADER * 27860000 *********************************************************************** 27870000 * RETURN CODE = 0 - OK * 27880000 * RETURN CODE = 2 - ERROR (H╨ú╨ûEH ERROR ╨ƒAKET) * 27890000 *********************************************************************** 27900000 RFILE SAVE 27910000 USING RFILE,BASE 27920000 LR BASE,R14 27930000 * 27940000 CALL RPACK ╨º╨ÿTAT╨¼ ╨ƒAKET OT ╨ƒAPTHEPA 27950000 BRTORC RFILE010,REST=RFILE700 27960000 RFILE010 CLI $R$CUR,AS ╨ƒP╨ÿ╨¿E╨¢ O╨ƒ╨»T╨¼ SEND_INIT ? 27970000 BE RFILE100 27980000 CLI $R$CUR,AZ ╨ƒP╨ÿ╨¿E╨¢ EOF ? 27990000 BE RFILE200 28000000 CLI $R$CUR,AF ╨ƒP╨ÿ╨¿E╨¢ FILE_HEADER ? 28010000 BE RFILE300 28020000 CLI $R$CUR,AB ╨ƒP╨ÿ╨¿E╨¢ BREAK - ╨ƒAKET ? 28030000 BE RFILE400 28040000 CLI $R$CUR,AE ╨ƒP╨ÿ╨¿E╨¢ ERROR - ╨ƒAKET ? 28050000 BE RFILE990 28060000 B RFILE700 ╨ƒOC╨¢AT╨¼ NAK 28070000 * 28080000 RFILE100 CLC $RETRY,RETRY MO╨ûHO ╨ƒOC╨½╨¢AT╨¼ E╨⌐E ? 28090000 BL RFILE150 EC╨¢╨ÿ MO╨ûHO, ╨ƒOC╨¢AT╨¼ ACK 28100000 MVI $STATE,C'A' BCE, ╨¢╨ÿM╨ÿT ╨ÿC╨ºEP╨ƒAH 28110000 B RFILE900 ╨ƒOC╨¢AT╨¼ ERROR ╨ƒAKET 28120000 RFILE150 EQU * 28130000 LH R3,$N$OLD ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ HOMEP ╨ƒAKETA 28140000 BCTR R3,1 B╨½╨ºECT╨¼ 1 - ╨ƒPE╨ö╨½╨ö╨ú╨⌐╨ÿ╨Ö HOMEP 28150000 CH R3,$N$CUR COB╨ƒA╨öA╨«T HOMEPA ? 28160000 BE RFILE160 EC╨¢╨ÿ ╨öA, TO BCE B ╨ƒOP╨»╨öKE 28170000 MVI #ERROR,E$BAD ╨ƒOTEP╨»H ╨ƒAKET 28180000 B RFILE800 ╨ƒOC╨¢AT╨¼ NAK 28190000 RFILE160 MVI $S$CUR,AY T╨ÿ╨ƒ ╨ƒAKETA - ACK 28200000 STH R3,$N$OLD ╨ùA╨ƒ╨ÿCAT╨¼ HOMEP ╨ƒAKETA 28210000 MVC $SDAT$L(2),=H'7' ╨ö╨¢╨ÿHA ╨öAHH╨½X - 7 ╨æA╨ÖT 28220000 CALL SPACK ╨ƒOC╨¢AT╨¼ ACK 28230000 BRTORC RFILE180,REST=RFILE900 28240000 RFILE180 LH R4,$N$OLD ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ HOMEP ╨ƒAKETA 28250000 LA R4,1(,R4) ╨úBE╨¢╨ÿ╨º╨ÿT╨¼ HA 1 28260000 STH R4,$N$OLD ╨ÿ ╨ùA╨ƒ╨ÿCAT╨¼ O╨æPATHO 28270000 XR R14,R14 RC = 0 28280000 B RFILERET ╨ÿ ╨û╨öAT╨¼C╨¢E╨ö╨ú╨«╨⌐E╨ôO ╨ƒAKETA 28290000 * ╨ƒP╨ÿ╨¿E╨¢ ╨ƒAKET 'Z' 28300000 RFILE200 CLC $N$OLD,$N$CUR COB╨ƒA╨öA╨«T HOMEPA ╨ƒAKETOB ? 28310000 BE RFILE230 EC╨¢╨ÿ ╨öA, ╨ƒOC╨¢AT╨¼ ACK HA FILE_HEADER 28320000 MVI #ERROR,E$BAD ╨ƒOTEP╨»H ╨ƒAKET 28330000 B RFILE800 ╨ƒOC╨¢AT╨¼ NAK 28340000 RFILE230 CALL SACK ╨ƒOC╨¢AT╨¼ ACK 28350000 MVI $STATE,C'F' ╨û╨öAT╨¼ ╨ƒP╨ÿXO╨öA ╨ƒAKETA 'F' ╨ÿ╨¢╨ÿ 'B' 28360000 XR R14,R14 RC = 0 28370000 B RFILERET 28380000 * ╨ƒP╨ÿ╨¿E╨¢ ╨ƒAKET 'F' 28390000 RFILE300 CLC $N$OLD,$N$CUR COB╨ƒA╨öA╨«T HOMEPA ╨ƒAKETOB ? 28400000 BE RFILE330 EC╨¢╨ÿ ╨öA, ╨ƒOC╨¢AT╨¼ ACK HA FILE_HEADER 28410000 MVI #ERROR,E$BAD ╨ƒOTEP╨»H ╨ƒAKET 28420000 B RFILE800 ╨ƒOC╨¢AT╨¼ NAK 28430000 RFILE330 CALL SACK ╨ƒOC╨¢AT╨¼ ACK 28440000 MVI $STATE,C'D' ╨û╨öAT╨¼ ╨ƒP╨ÿXO╨öA ╨öAHH╨½X 28450000 XR R14,R14 RC = 0 28460000 B RFILERET 28470000 * ╨ƒP╨ÿ╨¿E╨¢ ╨ƒAKET 'B' 28480000 RFILE400 CLC $N$OLD,$N$CUR COB╨ƒA╨öA╨«T HOMEPA ╨ƒAKETOB ? 28490000 BE RFILE430 EC╨¢╨ÿ ╨öA, ╨ƒOC╨¢AT╨¼ ACK HA FILE_HEADER 28500000 MVI #ERROR,E$BAD ╨ƒOTEP╨»H ╨ƒAKET 28510000 B RFILE800 ╨ƒOC╨¢AT╨¼ NAK 28520000 RFILE430 CALL SACK ╨ƒOC╨¢AT╨¼ ACK 28530000 MVI $STATE,C'C' ╨ùABEP╨¿EH╨ÿE PA╨æOT╨½ 28540000 XR R14,R14 RC = 0 28550000 B RFILERET 28560000 * 28570000 RFILE700 CLC $RETRY,RETRY MO╨ûHO ╨ƒOC╨½╨¢AT╨¼ E╨⌐E ? 28580000 BL RFILE800 28590000 MVI $STATE,C'A' BCE, ╨¢╨ÿM╨ÿT ╨ÿC╨ºEP╨ƒAH 28600000 B RFILE900 ╨ƒOC╨¢AT╨¼ ERROR ╨ƒAKET 28610000 RFILE800 MVI $S$CUR,AN T╨ÿ╨ƒ ╨ƒAKETA - NAK 28620000 XC $SDAT$L(2),$SDAT$L ╨ö╨¢╨ÿHA ╨öAHH╨½X = 0 28630000 CALL SPACK ╨ƒOC╨¢AT╨¼ NAK 28640000 BRTORC RFILE880,REST=RFILE900 28650000 RFILE880 XR R14,R14 RC = 0 28660000 B RFILERET ╨ÿ ╨û╨öAT╨¼ C╨¢E╨ö. ╨ƒAKET 28670000 RFILE900 LA R14,2 RC = 2 28680000 B RFILERET 28690000 RFILE990 MVI #ERROR,E$ERR ╨ƒP╨ÿ╨¿E╨¢ ERROR ╨ƒAKET 28700000 MVI $STATE,C'A' ╨ƒEPEXO╨ö B COCTO╨»H╨ÿE ABORT 28710000 LA R14,2 RC = 2 28720000 RFILERET RETURN 28730000 *********************************************************************** 28740000 LTORG 28750000 DROP BASE 28760000 *********************************************************************** 28770000 * ╨ƒP╨ÿEM ╨ƒAKETOB ╨öAHH╨½X * 28780000 *********************************************************************** 28790000 * RETURN CODE = 0 - OK * 28800000 * RETURN CODE = 2 - ERROR (H╨ú╨ûEH ERROR ╨ƒAKET) * 28810000 *********************************************************************** 28820000 RDATA SAVE 28830000 USING RDATA,BASE 28840000 LR BASE,R14 28850000 CALL RPACK C╨º╨ÿTAT╨¼ ╨ƒAKET OT ╨ƒAPTHEPA 28860000 BRTORC RDATA010,REST=RDATA800 28870000 RDATA010 CLI $R$CUR,AD ╨ƒP╨ÿ╨¿E╨¢ ╨ƒAKET ╨öAHH╨½X ? 28880000 BE RDATA100 28890000 CLI $R$CUR,AF ╨ƒP╨ÿ╨¿E╨¢ ╨ùA╨ôO╨¢OBOK ╨ñA╨Ö╨¢A ? 28900000 BE RDATA200 28910000 CLI $R$CUR,AZ ╨ƒP╨ÿ╨¿E╨¢ EOF ? 28920000 BE RDATA300 28930000 CLI $R$CUR,AE ╨ƒP╨ÿ╨¿E╨¢ ERROR ? 28940000 BE RDATA990 28950000 B RDATA400 28960000 * 28970000 RDATA100 CLC $N$OLD,$N$CUR CPABH╨ÿT╨¼ HOMEPA ╨ƒAKETOB 28980000 BNE RDATA200 EC╨¢╨ÿ HE COB╨ƒA╨¢╨ÿ, ╨ƒOC╨¢AT╨¼ ACK HA ╨ƒPE╨ö 28990000 CALL PTCHR ╨ƒO╨ö╨ƒPO╨ôPAMMA O╨æPA╨æOTK╨ÿ ╨öAHH╨½X 29000000 BRTORC RDATA110,REST=RDATA910 29010000 RDATA110 CALL SACK ╨ƒOC╨¢AT╨¼ ACK HA ╨ƒAKET ╨öAHH╨½X 29020000 B RDATRET ╨ÿ ╨û╨öAT╨¼ C╨¢E╨ö. ╨ƒAKET 29030000 * 29040000 RDATA200 CLC $RETRY,RETRY MO╨ûHO ╨ƒOC╨¢AT╨¼ ╨ƒAKET ? 29050000 BL RDATA220 EC╨¢╨ÿ MO╨ûHO, TO ╨ƒOC╨¢AT╨¼ 29060000 MVI $STATE,C'A' ╨ÿC╨ºEP╨ƒAH ╨¢╨ÿM╨ÿT 29070000 LA R14,8 RC = 8 29080000 B RDATRET ╨ƒPEKPAT╨ÿT╨¼ ╨ƒP╨ÿEM ╨ñA╨Ö╨¢A 29090000 RDATA220 EQU * 29100000 LH R4,$N$OLD ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ HOMEP ╨ƒAKETA 29110000 BCTR R4,0 B╨½╨ºECT╨¼ 1 - ACK HA ╨ƒPE╨ö. ╨ƒAKET 29120000 N R4,=X'0000003F' $N$OLD MOD 64 29130000 CH R4,$N$CUR TE╨ƒEP╨¼ COB╨ƒA╨¢╨ÿ HOMEPA ? 29140000 BE RDATA240 EC╨¢╨ÿ ╨öA, ╨ƒOC╨¢AT╨¼ ACK 29150000 MVI #ERROR,E$BAD ╨ƒOTEP╨»H ╨ƒAKET 29160000 B RDATA800 ╨ƒOC╨¢AT╨¼ NAK 29170000 RDATA240 STH R4,$N$OLD ╨ùA╨ƒ╨ÿCAT╨¼ HOMEP ╨ƒAKETA 29180000 CALL SACK ╨ƒOC╨¢AT╨¼ ACK 29190000 B RDATRET ╨ÿ ╨û╨öAT╨¼, ╨ºTO ╨ƒO╨¢╨ú╨º╨ÿ╨¢OC╨¼ 29200000 * 29210000 RDATA300 CLC $N$OLD,$N$CUR COB╨ƒA╨öA╨«T HOMEPA ╨ƒAKETOB ? 29220000 BE RDATA320 EC╨¢╨ÿ ╨öA, ╨ƒOC╨¢AT╨¼ ACK HA EOF 29230000 MVI #ERROR,E$BAD ╨ƒOTEP╨»H ╨ƒAKET 29240000 B RDATA800 ╨ƒOC╨¢AT╨¼ HAK HA EOF 29250000 RDATA320 LH R15,$PUT$L ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú ╨ƒOC╨¢E╨öHE╨Ö ╨ùA╨ƒ╨ÿC╨ÿ 29260000 LTR R15,R15 ECT╨¼ ╨öAHH╨½E ? 29270000 BZ RDATA340 EC╨¢╨ÿ HET, HE╨ºE╨ôO B╨½BO╨ö╨ÿT╨¼ 29280000 STH R15,$WR$L ╨ö╨¢╨ÿHA ╨ƒOC╨¢E╨öHE╨Ö ╨ùA╨ƒ╨ÿC╨ÿ 29290000 CALL WRITEX B╨½BECT╨ÿ ╨ùA╨ƒ╨ÿC╨¼ B ╨ñA╨Ö╨¢ 29300000 LTR R14,R14 29310000 BNZ RDATA900 29320000 RDATA340 CALL SACK ╨ƒOC╨¢AT╨¼ ACK HA EOF 29330000 MVI $STATE,C'F' ╨û╨öAT╨¼ BREAK ╨ÿ╨¢╨ÿ FILE_HEADER 29340000 XR R14,R14 RC = 0 29350000 B RDATRET ╨ÿ ╨ùA C╨¢E╨ö╨ú╨«╨⌐╨ÿM ╨ƒAKETOM 29360000 * 29370000 RDATA400 EQU * 29380000 CLC $RETRY,RETRY ╨ƒPEB╨½╨¿EH ╨¢╨ÿM╨ÿT HA ╨ƒOBTOP ? 29390000 BL RDATA420 HET 29400000 MVI $STATE,C'A' 29410000 LA R14,8 RC = 8 29420000 B RDATRET 29430000 RDATA420 CLI $R$CUR,AN ╨ƒP╨ÿ╨¿E╨¢ NAK ? 29440000 BE RDATA800 EC╨¢╨ÿ ╨öA, OTBET╨ÿT╨¼ NAK'OM 29450000 MVI $STATE,C'A' KOH╨º╨ÿT╨¼ ╨ƒP╨ÿEM ╨ñA╨Ö╨¢A 29460000 MVI #ERROR,E$TYPE HEBEPH╨½╨Ö T╨ÿ╨ƒ ╨ƒAKETA 29470000 B RDATRET ╨ÿ ╨ùABEP╨¿╨ÿT╨¼ 29480000 RDATA800 MVI $S$CUR,AN T╨ÿ╨ƒ ╨ƒAKETA - NAK 29490000 XC $SDAT$L(2),$SDAT$L ╨ö╨¢╨ÿHA ╨öAHH╨½X = 0 29500000 CALL SPACK ╨ƒOC╨¢AT╨¼ NAK 29510000 XR R14,R14 RC = 0 29520000 B RDATRET 29530000 RDATA900 MVI $STATE,C'A' HE╨ÿC╨ƒPAB╨ÿM╨½E O╨¿╨ÿ╨æK╨ÿ 29540000 LA R14,2 RC = 2 29550000 B RDATRET 29560000 RDATA910 EQU * 29570000 MVI $STATE,C'A' ╨ƒEPEXO╨ö B COCTO╨»H╨ÿE ABORT 29580000 LA R14,2 RC = 2 29590000 B RDATRET 29600000 RDATA990 MVI #ERROR,E$ERR ╨ƒP╨ÿ╨¿E╨¢ ERROR ╨ƒAKET 29610000 MVI $STATE,C'A' ╨ƒEPEXO╨ö B COCTO╨»H╨ÿE ABORT 29620000 LA R14,2 RC = 2 29630000 RDATRET RETURN 29640000 *********************************************************************** 29650000 LTORG 29660000 DROP BASE 29670000 *********************************************************************** 29680000 * ╨ƒO╨ö╨ƒPO╨ôPAMMA ╨ƒOC╨½╨¢K╨ÿ ACK * 29690000 *********************************************************************** 29700000 * RETURN CODE = 0 - OK * 29710000 * RETURN CODE = 2 - ERROR (H╨ú╨ûEH ERROR ╨ƒAKET) * 29720000 *********************************************************************** 29730000 SACK SAVE 29740000 USING SACK,BASE 29750000 LR BASE,R14 29760000 MVI $S$CUR,AY T╨ÿ╨ƒ ╨ƒAKETA - ACK 29770000 XC $SDAT$L(2),$SDAT$L ╨ƒAKET ╨æE╨ù ╨öAHH╨½X 29780000 CALL SPACK ╨ƒOC╨¢AT╨¼ ╨ƒAKET 29790000 BRTORC SACK010,REST=SACKERR 29800000 SACK010 LH R4,$N$OLD ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ HOMEP ╨ƒOC╨¢AH. ╨ƒAKETA 29810000 LA R4,1(,R4) ╨úBE╨¢╨ÿ╨º╨ÿT╨¼ HA 1 29820000 N R4,=X'0000003F' $N$OLD MOD 64 29830000 STH R4,$N$OLD ╨ùA╨ƒ╨ÿCAT╨¼ HOMEP O╨æPATHO 29840000 XR R14,R14 RC = 0 29850000 B SACKRET 29860000 SACKERR LA R14,2 RC = 2 29870000 SACKRET RETURN 29880000 *********************************************************************** 29890000 LTORG 29900000 DROP BASE 29910000 *********************************************************************** 29920000 * ╨ƒO╨ö╨ƒPO╨ôPAMMA O╨æPA╨æOTK╨ÿ ╨ƒP╨ÿ╨¿E╨ö╨¿╨ÿX B ╨ƒAKETE ╨öAHH╨½X * 29930000 *********************************************************************** 29940000 * RETURN CODE = 0 - OK * 29950000 * RETURN CODE = 2 - ERROR WRITE (H╨ú╨ûEH ERROR ╨ƒAKET) * 29960000 *********************************************************************** 29970000 PTCHR SAVE 29980000 USING PTCHR,BASE 29990000 LR BASE,R14 30000000 XR R0,R0 30010000 IC R0,QUOTE ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ QUOTE 30020000 XR R1,R1 30030000 IC R1,PREF 30040000 L R2,$DAT$A A╨öPEC IN DATA 30050000 LH R3,$RDAT$L ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú IN DATA 30060000 LH R4,$PUT$L CME╨⌐EH╨ÿE/╨ö╨¢╨ÿHA OUT DATA 30070000 L TDOABAR,$FMA A╨öPEC OUT DATA 30080000 LA R5,TDOADBA A╨öPEC OUT DATA 30090000 * 30100000 PTC#010 EQU * 30110000 LTR R3,R3 ECT╨¼ ╨öAHH╨½E ? 30120000 BNZ MOR EC╨¢╨ÿ ECT╨¼, O╨æPA╨æOTAT╨¼ 30130000 STH R4,$PUT$L 30140000 XR R14,R14 RC = 0 30150000 B PTCRET 30160000 * 30170000 MOR EQU * 30180000 LH R15,F#REC ╨ö╨¢╨ÿHA ╨ùA╨ƒ╨ÿC╨ÿ ╨ñA╨Ö╨¢A 30190000 TM FILSTAT,X'08' 30200000 BNZ PTC#510 HE V 30210000 TM FILSTAT,X'04' 30220000 BNO PTC#510 HE V 30230000 SH R15,=H'4' 30240000 PTC#510 EQU * 30250000 CR R4,R15 ECT╨¼ MECTO B ╨æ╨ú╨ñEPE ╨ö╨¢╨» 1 C╨ÿMB. ? 30260000 BNL PTC#600 HET 30270000 XR R14,R14 ╨ö╨¢╨» ╨ùA╨ôP╨ú╨ùK╨ÿ O╨ºEPE╨öHO╨ôO C╨ÿMBO╨¢A 30280000 IC R14,0(R2) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ O╨ºEPE╨öHO╨Ö C╨ÿMBO╨¢ 30290000 TM PGMSTAT,X'20' BE╨öETC╨» ╨ƒPE╨ñ╨ÿKCA╨ª╨ÿ╨» 8-╨ôO ╨æ╨ÿTA ? 30300000 BZ PTC#130 EC╨¢╨ÿ HET, HE ╨ƒPOBEP╨»T╨¼ 30310000 * 30320000 CR R14,R1 ╨ƒO╨¢╨ú╨ºEH PREF ? 30330000 BNE PTC#130 EC╨¢╨ÿ HET, ╨ƒPOBEP╨»T╨¼ ╨öA╨¢╨¼╨¿E 30340000 * ╨ƒO╨¢╨ú╨ºEH ╨ƒPE╨ñ╨ÿKC BOC╨¼MO╨ôO ╨æ╨ÿTA 30350000 LA R2,1(,R2) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ 30360000 BCTR R3,0 B╨½╨ºECT╨¼ 1 ╨ÿ╨ù C╨ºET╨º╨ÿKA 30370000 IC R14,0(R2) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ C╨ÿMBO╨¢ 30380000 CR R14,R0 PREF QUOTE ? 30390000 BE PTC#110 EC╨¢╨ÿ ╨öA, B╨½CTAB╨ÿT╨¼ HA C╨¢E╨ö. 30400000 O R14,=X'00000080' B╨½CTAB╨ÿT╨¼ 8-O╨Ö ╨æ╨ÿT 30410000 B PTC#500 ╨ùA╨ƒ╨ÿCAT╨¼ C╨ÿMBO╨¢ 30420000 * 30430000 PTC#110 EQU * 30440000 LA R2,1(,R2) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ 30450000 BCTR R3,0 B╨½╨ºECT╨¼ 1 ╨ÿ╨ù C╨ºET╨º╨ÿKA 30460000 IC R14,0(R2) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ C╨ÿMBO╨¢ 30470000 CR R14,R0 QUOTE ? 30480000 BE PTC#120 30490000 CR R14,R1 PREF ? 30500000 BE PTC#120 30510000 X R14,=X'00000040' CTL(R14) 30520000 PTC#120 O R14,=X'00000080' 30530000 B PTC#500 30540000 * 30550000 PTC#130 CR R14,R0 QUOTE ? 30560000 BNE PTC#500 EC╨¢╨ÿ HET, O╨æ╨½╨ºH╨½╨Ö C╨ÿMBO╨¢ 30570000 LA R2,1(,R2) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ HA C╨¢E╨ö. C╨ÿMB. 30580000 BCTR R3,0 B╨½╨ºECT╨¼ E╨⌐E 1 ╨ÿ╨ù C╨ºET╨º╨ÿKA 30590000 IC R14,0(R2) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ C╨ƒE╨ªC╨ÿMBO╨¢ 30600000 TM PGMSTAT,X'40' ╨ÿ╨öET ╨ƒP╨ÿEM TEXT ╨ñA╨Ö╨¢A ? 30610000 BZ PTC#360 HET. HE ╨ÿCKAT╨¼ CR LF 30620000 * 30630000 C R14,=X'0000004D' C R ? 30640000 BNE PTC#200 EC╨¢╨ÿ HET, ╨ƒPOBEP╨ÿT╨¼ L F 30650000 LA R2,1(,R2) ╨ƒEPEMECT╨ÿT╨¼ BXO╨öHO╨Ö ╨úKA╨ùATE╨¢╨¼ 30660000 BCTR R3,0 B╨½╨ºECT╨¼ E╨⌐E 1 ╨ÿ╨ù C╨ºET╨º╨ÿKA 30670000 B PTC#250 ╨ÿ B╨½BECT╨ÿ ╨ùA╨ƒ╨ÿC╨¼ 30680000 * 30690000 PTC#200 C R14,=X'0000004A' L F ? 30700000 BNE PTC#360 EC╨¢╨ÿ HET, ╨ƒPOBEP╨ÿT╨¼ QUOTE 30710000 LA R2,1(,R2) ╨ƒEPEMECT╨ÿT╨¼ BXO╨öHO╨Ö ╨úKA╨ùATE╨¢╨¼ 30720000 BCTR R3,0 B╨½╨ºECT╨¼ E╨⌐E 1 ╨ÿ╨ù C╨ºET╨º╨ÿKA 30730000 B PTC#010 30740000 * 30750000 PTC#250 EQU * 30760000 TM PGMSTAT,X'40' ╨ÿ╨öET ╨ƒP╨ÿEM TEXT ╨ñA╨Ö╨¢A ? 30770000 BZ PTC#320 HET. HE ╨ƒEPEKO╨ö╨ÿPOBAT╨¼ 30780000 * 30790000 LTR R4,R4 ECT╨¼ ╨öAHH╨½E B ╨ùA╨ƒ╨ÿC╨ÿ ? 30800000 BZ PTC#320 EC╨¢╨ÿ HET, HE ╨ƒEPEKO╨ö╨ÿPOBAT╨¼ 30810000 * 30820000 L R14,A#TRT#AE 30830000 LR R15,R5 COXPAH╨ÿT╨¼ PE╨ô╨ÿCTP 30840000 LR R0,R4 COXPAH╨ÿT╨¼ PE╨ô╨ÿCTP 30850000 * 30860000 PTC#280 CH R4,=H'256' 30870000 BNH PTC#300 30880000 TR 0(256,R5),0(R14) ╨ƒEPEBECT╨ÿ B ╨öKO╨ÿ 30890000 SH R4,=H'256' 30900000 LA R5,256(R5) 30910000 B PTC#280 30920000 * 30930000 PTC#800 TR 0(0,R5),0(R14) ╨ƒEPEBECT╨ÿ B ╨öKO╨ÿ 30940000 * 30950000 PTC#300 BCTR R4,0 ╨ö╨¢╨» TR 30960000 EX R4,PTC#800 30970000 LR R5,R15 BOCCTAHOB╨ÿT╨¼ PE╨ô╨ÿCTP 30980000 LR R4,R0 BOCCTAHOB╨ÿT╨¼ PE╨ô╨ÿCTP 30990000 XR R0,R0 31000000 IC R0,QUOTE ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ QUOTE 31010000 * 31020000 PTC#320 XC $PUT$L(2),$PUT$L ╨ùA╨ƒ╨ÿC╨¼ ╨ƒ╨úCTA╨» 31030000 STH R4,$WR$L 31040000 CALL WRITEX B╨½BECT╨ÿ ╨ùA╨ƒ╨ÿC╨¼ B ╨æ╨¢OK 31050000 L TDOABAR,$FMA BOCCTAHOB╨ÿT╨¼ A╨öPEC OUT DATA 31060000 LA R5,TDOADBA A╨öPEC OUT DATA 31070000 LTR R14,R14 OK ? 31080000 BZ PTC#340 ╨öA 31090000 LA R14,2 RC = 2 31100000 B PTCRET 31110000 * 31120000 PTC#340 EQU * 31130000 XR R4,R4 C╨æPOC╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú ╨ùA╨ƒ╨ÿC╨ÿ 31140000 B PTC#010 ╨ÿ ╨ƒPOBEP╨»T╨¼ C╨¢E╨ö╨ú╨«╨⌐╨ÿ╨Ö C╨ÿMBO╨¢ 31150000 * 31160000 PTC#360 EQU * 31170000 CR R14,R0 QUOTE ? 31180000 BE PTC#500 31190000 TM PGMSTAT,X'20' BE╨öETC╨» ╨ƒPE╨ñ╨ÿKCA╨ª╨ÿ╨» 8-╨ôO ╨æ╨ÿTA ? 31200000 BZ PTC#380 HET 31210000 CR R14,R1 PREF ? 31220000 BE PTC#500 31230000 PTC#380 X R14,=X'00000040' CTL(R14) 31240000 * 31250000 PTC#500 EQU * 31260000 STC R14,0(R5,R4) ╨ùA╨ƒ╨ÿCAT╨¼ C╨ÿMBO╨¢ 31270000 LA R4,1(,R4) ╨ƒEPEMECT╨ÿT╨¼ B╨½XO╨öHO╨Ö ╨ÿH╨öEKC 31280000 LA R2,1(,R2) A╨öPEC C╨¢E╨ö. C╨ÿMBO╨¢A IN DATA 31290000 BCT R3,PTC#010 ╨ƒEPEXO╨ö EC╨¢╨ÿ O╨æPA╨æOTAH HE BEC╨¼ ╨ƒAKET 31300000 B PTC#700 31310000 * O╨æPA╨æOTKA ╨ùA╨ƒO╨¢HEHHO╨ôO OUT ╨æ╨ú╨ñEPA 31320000 PTC#600 EQU * 31330000 TM PGMSTAT,X'40' ╨ÿ╨öET ╨ƒP╨ÿEM TEXT ╨ñA╨Ö╨¢A ? 31340000 BZ PTC#650 HET 31350000 * O╨æPA╨æOTKA ╨ùA╨ƒO╨¢HEHHO╨ôO OUT ╨æ╨ú╨ñEPA 31360000 * B TEKCTOBOM PE╨û╨ÿME 31370000 PTC#620 XR R14,R14 ╨ö╨¢╨» ╨ùA╨ôP╨ú╨ùK╨ÿ O╨ºEPE╨öHO╨ôO C╨ÿMBO╨¢A 31380000 IC R14,0(R2) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ O╨ºEPE╨öHO╨Ö C╨ÿMBO╨¢ 31390000 CR R14,R0 QUOTE ? 31400000 BNE PTC#640 HET - ERROR 31410000 LA R2,1(,R2) ╨ƒEPEMECT╨ÿT╨¼ ╨úKA╨ùATE╨¢╨¼ HA C╨¢E╨ö. C╨ÿMB. 31420000 BCTR R3,0 B╨½╨ºECT╨¼ E╨⌐E 1 ╨ÿ╨ù C╨ºET╨º╨ÿKA 31430000 IC R14,0(R2) ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ C╨ƒE╨ªC╨ÿMBO╨¢ 31440000 * 31450000 C R14,=X'0000004D' C R ? 31460000 BNE PTC#630 EC╨¢╨ÿ HET, ╨ƒPOBEP╨ÿT╨¼ L F 31470000 LA R2,1(,R2) ╨ƒEPEMECT╨ÿT╨¼ BXO╨öHO╨Ö ╨úKA╨ùATE╨¢╨¼ 31480000 BCTR R3,0 B╨½╨ºECT╨¼ E╨⌐E 1 ╨ÿ╨ù C╨ºET╨º╨ÿKA 31490000 B PTC#250 ╨ÿ B╨½BECT╨ÿ ╨ùA╨ƒ╨ÿC╨¼ 31500000 * 31510000 PTC#630 C R14,=X'0000004A' L F ? 31520000 BNE PTC#640 EC╨¢╨ÿ HET, ERROR 31530000 LA R2,1(,R2) ╨ƒEPEMECT╨ÿT╨¼ BXO╨öHO╨Ö ╨úKA╨ùATE╨¢╨¼ 31540000 BCT R3,PTC#620 ╨ƒEPEXO╨ö EC╨¢╨ÿ O╨æPA╨æOTAH HE BEC╨¼ ╨ƒAKET 31550000 B PTC#700 31560000 * 31570000 PTC#640 MVI #ERROR,E$TRUNC 31580000 LA R14,2 RC = 2 31590000 B PTCRET 31600000 * O╨æPA╨æOTKA ╨ùA╨ƒO╨¢HEHHO╨ôO OUT ╨æ╨ú╨ñEPA 31610000 * B PE╨û╨ÿME BINARY 31620000 PTC#650 XC $PUT$L(2),$PUT$L ╨ùA╨ƒ╨ÿC╨¼ ╨ƒ╨úCTA╨» 31630000 STH R4,$WR$L 31640000 CALL WRITEX B╨½BECT╨ÿ ╨ùA╨ƒ╨ÿC╨¼ 31650000 L TDOABAR,$FMA BOCCTAHOB╨ÿT╨¼ A╨öPEC OUT DATA 31660000 LA R5,TDOADBA A╨öPEC OUT DATA 31670000 XR R4,R4 C╨æPOC╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú ╨ùA╨ƒ╨ÿC╨ÿ 31680001 LTR R14,R14 OK ? 31690000 BZ PTC#010 ╨öA 31700001 LA R14,2 RC = 2 31710000 B PTCRET 31720000 * 31730000 * KOHE╨ª O╨æPA╨æOTK╨ÿ ╨ùA╨ƒO╨¢HEHHO╨ôO ╨æ╨ú╨ñEPA 31740000 * 31750001 PTC#700 STH R4,$PUT$L 31760000 XR R14,R14 RC = 0 31770000 B PTCRET 31780000 * 31790000 PTCRET RETURN 31800000 *********************************************************************** 31810000 LTORG 31820000 DROP BASE 31830000 *********************************************************************** 31840000 * ╨ƒO╨ö╨ƒPO╨ôPAMMA B╨½BO╨öA ╨öAHH╨½X HA ╨ö╨ÿCK * 31850000 *********************************************************************** 31860000 * RETURN CODE = 0 - OK * 31870000 * RETURN CODE = 2 - ERROR * 31880000 * RETURN CODE = 4 - HEPAC╨ƒO╨ùHAHHA╨» O╨¿╨ÿ╨æKA B╨½BO╨öA * 31890000 *********************************************************************** 31900000 WRITEX SAVE 31910000 USING WRITEX,BASE ╨úCTAHOB╨ÿT╨¼ A╨öPECA╨ª╨ÿ╨« 31920000 LR BASE,R14 ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨æA╨ùOB╨½╨Ö PE╨ô╨ÿCTP 31930000 L TDOABAR,$FMA 31940000 LH R3,$WR$L ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú B╨½BO╨ö╨ÿMO╨Ö ╨ùA╨ƒ╨ÿC╨ÿ 31950000 LTR R3,R3 ╨ö╨¢╨ÿHA = 0 ? 31960000 BNZ WRT000 HET 31970000 LA R3,1 31980000 LA R14,64 ╨ƒPO╨æE╨¢ B KO╨öE EBCDIC 31990000 STC R14,TDOADBA 32000000 * 32010000 WRT000 EQU * 32020000 TM FILSTAT,X'08' 32030000 BNZ WRT012 HE V 32040000 TM FILSTAT,X'04' 32050000 BNO WRT012 HE V 32060000 * 32070000 LA R3,4(R3) ╨ö╨¢╨ÿHA ╨öAHH╨½X + ╨ö╨¢╨ÿHA RDW 32080000 CH R3,F#REC ╨ö╨¢╨ÿHA CTPOK╨ÿ < ╨ö╨¢╨ÿH╨½ OUT ╨ùA╨ƒ╨ÿC╨ÿ ? 32090000 BL WRT010 ╨öA 32100000 LH R3,F#REC 32110000 SH R3,=H'4' ╨ö╨¢╨ÿHA ╨öAHH╨½X ╨æE╨ù RDW 32120000 B WRT020 32130000 WRT010 LA R14,=F'0' 32140000 SH R3,=H'4' ╨ö╨¢╨ÿHA ╨öAHH╨½X ╨æE╨ù RDW 32150000 ST R3,0(R14) 32160000 LA R15,64 ╨ƒPO╨æE╨¢ B KO╨öE EBCDIC 32170000 STC R15,0(R14) 32180000 L R3,0(R14) ╨ö╨¢╨ÿHA ╨ÿ C╨ÿMBO╨¢ ╨ùA╨ƒO╨¢H╨ÿTE╨¢╨¼ 32190000 B WRT020 32200000 * 32210000 WRT012 CH R3,F#REC ╨ö╨¢╨ÿHA CTPOK╨ÿ < ╨ö╨¢╨ÿH╨½ OUT ╨ùA╨ƒ╨ÿC╨ÿ ? 32220000 BL WRT014 ╨öA 32230000 LH R3,F#REC 32240000 B WRT020 32250000 WRT014 LA R14,=F'0' ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC C╨¢OBA 32260000 ST R3,0(R14) ╨ùA╨ƒ╨ÿCAT╨¼ B HE╨ôO ╨ö╨¢╨ÿH╨ú 32270000 LA R15,64 ╨ƒPO╨æE╨¢ B KO╨öE EBCDIC 32280000 STC R15,0(R14) ╨ùA╨ƒ╨ÿCAT╨¼ ╨ƒPO╨æE╨¢ B CTAP╨¿. ╨æA╨ÖT C╨¢OBA 32290000 L R3,0(R14) ╨ö╨¢╨ÿHA ╨ÿ C╨ÿMBO╨¢ ╨ùA╨ƒO╨¢H╨ÿTE╨¢╨¼ 32300000 * 32310000 WRT020 LA R2,TDOADBA A╨öPEC ╨æ╨ú╨ñEPA PAC╨ƒAKOBK╨ÿ 32320000 LA R4,TDOAVRL A╨öPEC ╨æ╨ú╨ñEPA B╨½BO╨öA (!) 32330000 LH R5,F#REC ╨ö╨¢╨ÿHA ╨æ╨ú╨ñEPA B╨½BO╨öA 32340000 TM FILSTAT,X'08' 32350000 BNZ WRT030 HE V 32360000 TM FILSTAT,X'04' 32370000 BNO WRT030 HE V 32380000 LR R14,R3 32390000 LA R14,4(R14) LENGHT + L'RDW 32400000 STH R14,0(R4) RECORD DESCRIPTOR WORD 32410000 XC 2(2,R4),2(R4) RDW 32420000 LA R4,4(R4) A╨öPEC ╨öAHH╨½X B ╨æ╨ú╨ñEPE B╨½BO╨öA 32430000 SH R5,=H'4' ╨ö╨¢╨ÿHA ╨öAHH╨½X B ╨æ╨ú╨ñEPE B╨½BO╨öA 32440000 WRT030 EQU * 32450000 MVCL R4,R2 ╨ùA╨ƒO╨¢HEH╨ÿE ╨æ╨ú╨ñEPA B╨½BO╨öA 32460000 MVC TCATDDI(4),FILEDEST ╨ÿM╨» ╨ƒ╨úHKTA HA╨ùHA╨ºEH╨ÿ╨» 32470000 LA R14,TDOAVRL A╨öPEC ╨æ╨ú╨ñEPA B╨½BO╨öA 32480000 ST R14,TCATDAA 32490000 DFHTD TYPE=PUT,IOERROR=WRT100,NOSPACE=WRT200,NORESP=WRT700 32500000 MVI #ERROR,E$CICS 32510000 LA R14,4 RC = 4 32520000 B WRTRET 32530000 WRT100 EQU * 32540000 MVI #ERROR,E$PIO 32550000 LA R14,2 RC = 2 32560000 B WRTRET 32570000 WRT200 EQU * 32580000 MVI #ERROR,E$SPACE 32590000 LA R14,2 RC = 2 32600000 B WRTRET 32610000 WRT700 EQU * 32620000 XC $WR$L(2),$WR$L 32630000 XR R14,R14 RC = 0 32640000 WRTRET RETURN 32650000 *********************************************************************** 32660000 LTORG 32670000 DROP BASE 32680000 *********************************************************************** 32690000 * B╨½BO╨ö COO╨æ╨⌐EH╨ÿ╨Ö COURIER - CICS * 32700000 *********************************************************************** 32710000 * RETURN CODE = 0 - OK * 32720000 *********************************************************************** 32730000 WRS SAVE 32740000 USING WRS,BASE ╨úCTAHOB╨ÿT╨¼ A╨öPECA╨ª╨ÿ╨« 32750000 LR BASE,R14 ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨æA╨ùOB╨½╨Ö PE╨ô╨ÿCTP 32760000 XR R2,R2 ╨ö╨¢╨» ╨ùA╨ôP╨ú╨ùK╨ÿ ╨ö╨¢╨ÿH╨½ COO╨æ╨⌐EH╨ÿ╨» 32770000 IC R2,PACKAGE ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ ╨ö╨¢╨ÿH╨ú 32780000 LA R3,2(R2) ╨ö╨¢╨ÿHA CR LF 32790000 L TIOABAR,$SMA ╨ùA╨ôP╨ú╨ù╨ÿT╨¼ A╨öPEC TIOA 32800000 STH R3,TIOATDL ╨ùA╨ƒ╨ÿCAT╨¼ ╨ö╨¢╨ÿH╨ú TIOA 32810000 MVC TIOADBA(2),=X'0D25' ╨ùA╨ƒ╨ÿCAT╨¼ CR LF 32820000 BCTR R2,0 B╨½╨ºECT╨¼ 1 ╨ö╨¢╨» MVC 32830000 EX R2,WRS600 ╨ùA╨ƒ╨ÿCAT╨¼ TEKCT COO╨æ╨⌐EH╨ÿ╨» 32840000 ST TIOABAR,TCTTEDA ╨ùA╨ƒ╨ÿCAT╨¼ A╨öPEC TIOA B TCTTE 32850000 DFHTC TYPE=(PUT,SAVE) B╨½BECT╨ÿ COO╨æ╨⌐EH╨ÿE 32860000 XR R14,R14 RC=0 32870000 B WRS##010 32880000 WRS600 MVC TIOADBA+2(0),PACKAGE+1 32890000 WRS##010 RETURN 32900000 *********************************************************************** 32910000 LTORG 32920000 DROP BASE 32930000 END 32940000