home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
cicsussr.zip
/
ecker-koi8.asm
< prev
next >
Wrap
Assembly Source File
|
1991-08-21
|
270KB
|
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