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