* 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 ' 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Я ? 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Я ? 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