Columbia Kermit

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

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

Wrap

Assembly Source File | 2020-01-01 | 267KB | 3,295 lines

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