home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
ibmtsochicago.tar.gz
/
ibmtsochicago.tar
/
tsoker.asm
< prev
next >
Wrap
Assembly Source File
|
1984-07-18
|
210KB
|
2,596 lines
KERMIT TITLE 'KERMIT-IBM' TSO00010
MACRO TSO00020
REGISTER TSO00030
LCLA &N TSO00040
SPACE TSO00050
*********************************************************************** TSO00060
* GENERAL REGISTER EQUATES * TSO00070
*********************************************************************** TSO00080
SPACE TSO00090
&N SETA 0 TSO00100
.LOOP ANOP TSO00110
R&N EQU &N TSO00120
AIF (&N EQ 15).OUT TSO00130
&N SETA &N+1 TSO00140
AGO .LOOP TSO00150
.OUT ANOP TSO00160
SPACE TSO00170
MEND TSO00180
MACRO TSO00190
&LABEL BINCVRT ®,&AREA,&DBLWRK TSO00200
.* TSO00210
.* CONVERT THE CONTENTS OF ® TO DECIMAL AND EDIT INTO &AREA. TSO00220
.* &AREA IS A FIELD OF LENGTH SIX THAT WILL CONTAIN THE INTEGER TSO00230
.* STRING WITH LEADING BLANKS SUPRESSED. &DBLWRK IS A DOUBLE TSO00240
.* WORK SPACE. TSO00250
.* TSO00260
&LABEL CVD ®,&DBLWRK TSO00270
MVC &AREA.(6),=X'402020202120' TSO00280
ED &AREA.(6),&DBLWRK+5 TSO00290
MEND TSO00300
MACRO TSO00310
&LAB WRTERM &MSG TSO00320
LCLC &MS TSO00330
LCLA &LN TSO00340
&MS SETC '&MSG' TSO00350
&LN SETA K'&MS TSO00360
&LN SETA &LN-2 TSO00370
&LAB TPUT =C&MS,&LN TSO00380
MEND TSO00390
MACRO TSO00400
&LAB PROMPT &MSG TSO00410
LCLC &MS TSO00420
LCLA &LN TSO00430
&MS SETC '&MSG' TSO00440
&LN SETA K'&MS TSO00450
&LN SETA &LN-2 TSO00460
&LAB TPUT =C&MS,&LN,ASIS TSO00470
MEND TSO00480
MACRO TSO00490
RDTERM &BUFF TSO00500
TGET &BUFF,130 TSO00510
MEND TSO00520
KERMIT CSECT TSO00530
* TSO00540
* ---------------------------------------- TSO00550
* TSO00560
* KERMIT/TSO - TSO00570
* TSO00580
* Kermit - KL10 Error-free Reciprocol Micro Interface Transfer TSO00590
* IBM Version 1.0 TSO00600
* TSO00610
* This program is the IBM MVS/TSO side of a file transfer system. TSO00620
* It can be used to transfer files between a micro and a system TSO00630
* running under MVS/TSO. It MUST be run as a Command Processor. TSO00640
* See the KERMIT manual for the complete program specifications TSO00650
* to which this program and any other component of the system TSO00660
* must adhere. TSO00670
* TSO00680
* Ronald J. Rusnak, University of Chicago Computation Center TSO00690
* BITNET address, SYSRONR at UCHIVM1 TSO00700
* MAILNET address, SYSTEMS.RON@UCHICAGO.MAILNET TSO00710
* ARPA forwarding address, SYSTEMS.RON%UCHICAGO@MIT-MULTICS.ARPA TSO00720
* May 1984 TSO00730
* TSO00740
* Developed by the modification of the IBM CMS version written by TSO00750
* Daphne Tzoar, Columbia University Center for Computing Activities TSO00760
* March 1982 TSO00770
* TSO00780
* Copyright (C) 1984 University of Chicago TSO00790
* TSO00800
* Permission is granted to any individual or institution to copy TSO00810
* or use this program, except for explicitly commercial purposes. TSO00820
* TSO00830
* TSO00840
* The following external subroutines are required: TSO00850
* -DYNALC - MVS dynamic allocation interface. TSO00860
* TSO00870
* TSO00880
* ---------------------------------------- TSO00890
* TSO00900
* Note that this is an experimental version; all changes should TSO00910
* be forwarded to the author. TSO00920
* TSO00930
EJECT TSO00940
* REGISTER USAGE - TSO00950
* R1 - TSO00960
* R2 - TSO00970
* R3 - TSO00980
* R4 - TSO00990
* R5 - TSO01000
* R6 - TSO01010
* R7 - TSO01020
* R8 - TSO01030
* R9 - TSO01040
* R10 - TSO01050
* R11 - BASE REGISTER FOR GLOBAL DATA AREA TSO01060
* R12 - PROGRAM BASE TSO01070
* R13 - SAVE AREA TSO01080
* R14 - SUBROUTINE LINKAGE TSO01090
* R15 - SUBROUTINE LINKAGE TSO01100
* TSO01110
SPACE TSO01120
PRINT NOGEN TSO01130
REGISTER TSO01140
IKJCPPL TSO01150
IKJUPT TSO01160
SPACE TSO01170
AD EQU 68 DATA PACKET (ASCII 'D') TSO01180
AN EQU 78 NAK TSO01190
AZ EQU 90 EOF PACKET TSO01200
AS EQU 83 INIT PACKET TSO01210
AY EQU 89 ACK TSO01220
AF EQU 70 FILE PACKET TSO01230
AB EQU 66 BREAK PACKET TSO01240
AE EQU 69 ERROR PACKET TSO01250
ERCOD EQU 12 MEANS EOF WITH 'FSREAD' TSO01260
FLG1 EQU X'80' IS FILE THE FIRST OR NOT TSO01270
FLG2 EQU X'40' OVERWRITE SENT FILENAME? TSO01280
FLG3 EQU X'20' ONE = SENT ONLY PARTIAL RECORD TSO01290
FLG4 EQU X'10' NAK FROM MICRO(0) OR RPACK(1)? TSO01300
FLG5 EQU X'08' ALLOCATED MORE SPACE (DMSFREE) TSO01310
EJECT TSO01320
DCBD DSORG=(PS) TSO01330
EJECT TSO01340
********************************************************************** TSO01350
* * TSO01360
* KERMIT-TSO PROGRAM * TSO01370
* * TSO01380
********************************************************************** TSO01390
KERMIT CSECT TSO01400
STM R14,R12,12(R13) TSO01410
BALR R12,0 TSO01420
USING *,R12 TSO01430
LA R14,KSAVE TSO01440
ST R13,4(R14) TSO01450
ST R14,8(R13) TSO01460
LR R13,R14 TSO01470
* USE R11 AS BASE REGISTER FOR THE SHARED DATA AREA TSO01480
L R11,=A(PARMS) TSO01490
USING PARMS,R11 TSO01500
TM 0(R1),X'80' IS THIS A COMMAND PROCESSOR? TSO01510
BO NOTCP NO, THEN REFUSE USER TSO01520
* TSO01530
* collect users mvs-tso prefix. TSO01540
* TSO01550
L R2,CPPLUPT-CPPL(,R1) GET TO UPT TSO01560
XR R3,R3 CLEAR R3 TSO01570
IC R3,UPTPREFL-UPT(,R2) GET LENGTH TSO01580
BCTR R3,0 TSO01590
ST R3,PREFIXL SAVE FOR LATER TSO01600
MVC PREFIX(*-*),UPTPREFX-UPT(R2) MOVE PREFIX TSO01610
EX R3,*-6 TSO01620
GTSIZE , GET TERMINAL INFO TSO01630
LTR R0,R0 IS THIS A GRAPHICS DEVICE? TSO01640
BNZ BADDEV YES, THEN REFUSE USER TSO01650
L R15,=A(INIT) TSO01660
BALR R14,R15 CALL THE INITIALIZATION TSO01670
WRTERM 'KERMIT-TSO Version 1.00' TSO01680
WRTERM ' ' TSO01690
********************************************************************** TSO01700
* * TSO01710
* MAIN COMMAND PROCESSING ROUTINE * TSO01720
* * TSO01730
********************************************************************** TSO01740
PROMPT PROMPT 'KERMIT-TSO> ' TSO01750
RDTERM INPUT TSO01760
* TSO01770
TR INPUT,UPPER UPPERCASE INPUT TSO01780
LA R1,INPUT R1 GETS ADDRESS OF STRING TSO01790
L R0,=F'130' R0 GETS THE LENGTH TSO01800
L R15,=A(PARSER) TSO01810
BALR R14,R15 DO TOKENIZING TSO01820
* TSO01830
LM R7,R9,PARSELST SAVE ADDR OF TOKENIZED LIST TSO01840
L R6,0(,R7) GET THE PTR TO FIRST OPERAND TSO01850
NOPRO MVI ERRNUM,X'FF' RESET ERROR FOR THIS TIME TSO01860
CLI 0(R6),C' ' BARE CARRIAGE RETURN? TSO01870
BE PROMPT IGNORE IT TSO01880
CLI 0(R6),C'E' CHECK FOR 'EXIT' COMMAND TSO01890
BE LEAVE TSO01900
CLI 0(R6),C'Q' CHECK FOR 'QUIT' COMMAND TSO01910
BE LEAVE TSO01920
CLI 0(R6),C'?' NEED HELP ? TSO01930
BNE SETCHK TSO01940
WRTERM 'Legal Commands are: ' TSO01950
WRTERM 'Receive, Send, Help, Exit, Quit, Set, Status, Show .' TSO01960
B PROMPT TSO01970
SETCHK CLC =C'SET',0(R6) IS IT THE SET COMMAND ? TSO01980
BE STSWITCH TSO01990
CLC =C'ST',0(R6) IS IT THE STATUS COMMAND? TSO02000
BE STATSW TSO02010
CLC =C'SH',0(R6) IS IT THE SHOW COMMAND? TSO02020
BE SHOSW TSO02030
CLC =C'HE',0(R6) NEED HELP ? TSO02040
BE HELPSW TSO02050
OI FLAGS,FLG1 SET FLG1 - IT'S THE FIRST FILE TSO02060
NI FLAGS,X'FF'-FLG2 TURN OFF OVERWRITE FLAG (INIT) TSO02070
CLC =C'RE',0(R6) TSO02080
BNE SS MAYBE IT'S A SEND COMMAND TSO02090
********************************************************************** TSO02100
* PROCESS RECEIVE COMMAND * TSO02110
********************************************************************** TSO02120
BXH R7,R8,RR3 GET NEXT OPERAND TSO02130
L R6,0(,R7) GET POINTER TO NEXT OPERAND TSO02140
CLI 0(R6),C'?' NEED HELP? TSO02150
BNE RR2 TSO02160
WRTERM 'Specify dsname to be created for RECEIVE.' TSO02170
B PROMPT TSO02180
RR2 CLI 0(R6),C' ' MORE WORDS ? TSO02190
BE RR3 NO, THEN PROMPT TSO02200
MVC DSNAMEX(80),=CL80' ' BLANK DSNAME TSO02210
LA R1,DSNAMEX POINT TO DSNAME BUFFER TSO02220
LA R2,44 MAX LENGTH OF DSNAME TSO02230
SR R5,R5 ZERO THE LENGTH TSO02240
RR4 CLI 0(R6),C' ' IS THIS END OF FIELD TSO02250
BE RR5 YES, THEN PROCESS DSNAME TSO02260
MVC 0(1,R1),0(R6) MOVE A CHARACTER TSO02270
LA R6,1(,R6) MOVE ALONG INPUT BUFFER TSO02280
LA R1,1(,R1) MOVE ALONG DSNAME BUFFER TSO02290
LA R5,1(,R5) UP THE LENGTH COUNT TSO02300
BCT R2,RR4 KEEP LOOKING FOR END TSO02310
WRTERM 'Dsname too long' TSO02320
* TSO02330
* allocate a new data set for receive TSO02340
* dynaloc will not prefix - so we have to do this by hand. TSO02350
* TSO02360
RR3 WRTERM 'Enter data set name for RECEIVE.' TSO02370
MVC DSNAMEX(80),=CL80' ' BLANK FIELD TSO02380
TGET DSNAMEX,44 GET DSNAME TSO02390
TR DSNAMEX(80),UPPER MAKE UPPER CASE DSN TSO02400
LR R5,R1 SAVE TGET LENGTH TSO02410
RR5 LA R6,DSNAMEX SOURCE TSO02420
MVC DSNAME(44),=CL44' ' BLANK FIELD TSO02430
LA R2,DSNAME PLACE TO STUFF DSNAME TSO02440
CLI DSNAMEX,C'''' TEST IF QUOTED TSO02450
BE GBDSNQ1 BR IF SO TSO02460
* TSO02470
* we'll prefix the dsname "by hand". TSO02480
* TSO02490
L R3,PREFIXL ELSE GET EX LEN TSO02500
MVC 0(*-*,R2),PREFIX MOVE PREFIX TO BUFFER TSO02510
EX R3,*-6 MOVE IT TSO02520
LA R2,1(R3,R2) NEXT POS IN BUFFER TSO02530
MVI 0(R2),C'.' PUT A DOT IN THERE TSO02540
LA R2,1(,R2) PLACE FOR REST OF DSNAME TSO02550
B GBDSNQ2 CONTINUE TSO02560
GBDSNQ1 DS 0H X TSO02570
LA R6,1(,R6) PAST QUOTE TSO02580
S R5,=F'2' REDUCE LENGTH BY 2 TSO02590
* TSO02600
* build the parm list to the MVS dynalc routine. TSO02610
* TSO02620
GBDSNQ2 DS 0H TSO02630
BCTR R5,0 DEC LEN FOR EX TSO02640
MVC 0(*-*,R2),0(R6) COMPLETE DSNAME TSO02650
EX R5,*-6 TSO02660
MVC DDNAME(8),=CL8'KEROUT' TSO02670
MVC DISP1(4),=F'0' A NEW DATA SET TSO02680
MVC DISP2(4),=F'1' CATLG TSO02690
MVC INOUT(4),=F'1' OUTPUT TSO02700
MVC RECFMX(4),=F'1' FB DATA SET TSO02710
MVC TRACK(4),=F'5' 5 TRACK ALLOC TSO02720
* TSO02730
* select a model dcb. either f or v TSO02740
* TSO02750
MVC KEROUT(MODDCBFL),MODDCBF TSO02760
CLI RFM,C'F' DOES USER WANT FB TSO02770
BE MAKDCB YES TSO02780
MVC KEROUT(MODDCBVL),MODDCBV USE V MODEL TSO02790
MAKDCB DS 0H TSO02800
* TSO02810
* NOW CHECK THE LRECL AND BLKSIZE BEFORE OPEN TSO02820
* TSO02830
SR R1,R1 CLEAR R1 TSO02840
IC R1,LRECL GET LRECL TSO02850
SR R2,R2 CLEAR R2 TSO02860
LH R3,BLKSIZE GET BLKSIZE TSO02870
CLI RFM,C'V' IS THIS VARIABLE TSO02880
BE CHKFIXD NO, THEN CHECK AS IF FIXED TSO02890
DR R2,R1 SEE IF BLKSIZE IS A MULTIPLE TSO02900
LTR R2,R2 OF THE LRECL TSO02910
BNZ CHKBLKER YES, THEN SET LRECL AND BLKSIZE TSO02920
LH R3,BLKSIZE GET BLKSIZE TSO02930
B SETLB TSO02940
CHKBLKER WRTERM 'BLKSIZE not multiple of LRECL for RECFM=F' TSO02950
B PROMPT TSO02960
CHKFIXD SH R3,=H'4' ADJUST BLKSIZE TSO02970
CR R1,R3 IS LRECL =< BLKSIZE - 4 TSO02980
BNH CHKFIXD2 YES, THEN SET LRECL AND BLKSIZE TSO02990
WRTERM 'LRECL not less than BLKSIZE - 4 FOR RECFM=V' TSO03000
B PROMPT TSO03010
CHKFIXD2 AH R3,=H'4' READJUST BLKSIZE TSO03020
SETLB DS 0H TSO03030
STH R1,KEROUT+(DCBLRECL-IHADCB) STUFF IN DCB TSO03040
STH R3,KEROUT+(DCBBLKSI-IHADCB) TSO03050
ST R3,BLKSIZEX BLKSIZE TSO03060
ST R1,LRECLX LRECL TSO03070
LOCATE DATASET TSO03080
LTR R15,R15 DOES DATASET EXIST? TSO03090
BNZ RRALOC NO, THEN ALLOC A NEW ONE TSO03100
PROMPT 'Dataset exists, reply "OK" to overwrite: ' TSO03110
TGET WRKBUFF,3 TSO03120
OC WRKBUFF(3),=CL80' ' UPPER CASE REPLY TSO03130
CLC =C'OK',WRKBUFF TSO03140
BNE PROMPT BR, IF NOT OK TSO03150
MVC DISP1,=F'1' MAKE DISP OLD TSO03160
MVC DISP2,=F'3' KEEP TSO03170
RRALOC L R15,=V(DYNALC) -> ENTRY POINT TSO03180
LA R1,DYNAPARM PARMS FOR ALLOC TSO03190
BALR R14,R15 DO IT TSO03200
* TSO03210
ICM R1,B'1111',DYNALCRC GET RETURN OCDE TSO03220
BNZ PROMPT BR IF FAILURE TSO03230
* TSO03240
* ... then we'll merge in these dcb attributes TSO03250
* TSO03260
MAKDCBX DS 0H TSO03270
OPEN (KEROUT,(OUTPUT)) TSO03280
TM KEROUT+(DCBOFLGS-IHADCB),DCBOFOPN TSO03290
BO GBOPNA TSO03300
WRTERM 'Open for dataset failed.' TSO03310
B PROMPT TSO03320
* TSO03330
* a breeze... TSO03340
* TSO03350
GBOPNA DS 0H TSO03360
WRTERM 'Receive waiting...' TSO03370
L R15,=A(RECEIVE) TSO03380
BALR R14,R15 CALL RECEIVE PORTION TSO03390
LTR R5,R15 CHECK RETURN CODE TSO03400
BNZ LNON TSO03410
MVI ERRNUM,X'FF' TSO03420
LNON DS 0H TSO03430
* TSO03440
* close any open data sets. TSO03450
* TSO03460
CLOSE (KERIN,,KEROUT) TSO03470
MVC OLDERR(1),ERRNUM ERROR SETTING OF THIS RUN TSO03480
LTR R5,R5 CHECK THE RETCODE TSO03490
BZ PROMPT ALL OKAY TSO03500
WRTERM 'Error in receiving file. Try again.' TSO03510
B PROMPT ERROR - TRY AGAIN TSO03520
SS CLC =C'SEN',0(R6) TSO03530
BNE ERR UNRECOGNIZED COMMAND TSO03540
********************************************************************** TSO03550
* PROCESS SEND COMMAND * TSO03560
********************************************************************** TSO03570
BXH R7,R8,SS3 NO MORE LEFT TSO03580
L R6,0(R7) PICK UP NEXT OPERAND TSO03590
CLI 0(R6),C'?' NEED HELP? TSO03600
BNE SS2 TSO03610
WRTERM 'Specify dataset name.' [ ] TSO03620
B PROMPT TSO03630
SS2 CLI 0(R6),C' ' MORE DATA ? TSO03640
* TSO03650
* User wants to send a data set - well... TSO03660
* TSO03670
BE SS3 NO, THEN PROMPT TSO03680
MVC DSNAMEX(80),=CL80' ' BLANK DSNAME TSO03690
LA R1,DSNAMEX POINT TO DSNAME BUFFER TSO03700
LA R2,44 MAX LENGTH OF DSNAME TSO03710
SR R5,R5 CLEAR LENGTH TSO03720
SS4 CLI 0(R6),C' ' IS THIS END OF FIELD TSO03730
BE SS5 YES, THEN PROCESS DSNAME TSO03740
MVC 0(1,R1),0(R6) MOVE A CHARACTER TSO03750
LA R6,1(,R6) MOVE ALONG INPUT BUFFER TSO03760
LA R1,1(,R1) MOVE ALONG DSNAME BUFFER TSO03770
LA R5,1(,R5) UP THE LENGTH COUNT TSO03780
BCT R2,SS4 KEEP LOOKING FOR END TSO03790
WRTERM 'Dsname too long' TSO03800
B PROMPT TSO03810
SS3 WRTERM 'Enter dataset name to send.' TSO03820
MVC DSNAMEX(80),=CL80' ' BLANK FIELD TSO03830
TGET DSNAMEX,44 GET DSNAME TSO03840
TR DSNAMEX(80),UPPER MAKE UPPER CASE DSN TSO03850
LR R5,R1 SAVE TGET LENGTH TSO03860
SS5 LA R6,DSNAMEX SOURCE TSO03870
MVC DSNAME(44),=CL44' ' BLANK FIELD TSO03880
LA R2,DSNAME PLACE TO STUFF DSNAME TSO03890
CLI DSNAMEX,C'''' TEST IF QUOTED TSO03900
BE GBDSNQ3 BR IF SO TSO03910
* TSO03920
* user tests if i know how to prefix a dsname. TSO03930
* TSO03940
L R3,PREFIXL ELSE GET EX LEN TSO03950
MVC 0(*-*,R2),PREFIX MOVE PREFIX TO BUFFER TSO03960
EX R3,*-6 MOVE IT TSO03970
LA R2,1(R3,R2) NEXT POS IN BUFFER TSO03980
MVI 0(R2),C'.' PUT A DOT IN THERE TSO03990
LA R2,1(,R2) PLACE FOR REST OF DSNAME TSO04000
B GBDSNQ4 CONTINUE TSO04010
GBDSNQ3 DS 0H X TSO04020
LA R6,1(,R6) PAST QUOTE TSO04030
S R5,=F'2' REDUCE LENGTH BY 2 TSO04040
* TSO04050
* build a "control block" TSO04060
* TSO04070
GBDSNQ4 DS 0H TSO04080
BCTR R5,0 DEC LEN FOR EX TSO04090
MVC 0(*-*,R2),0(R6) COMPLETE DSNAME TSO04100
EX R5,*-6 TSO04110
LA R5,DSNAME+43 POINT TO END OF DSNAME TSO04120
LA R4,44 LENGTH OF DSNAME TSO04130
SSFINDL1 CLI 0(R5),C' ' IS IT BLANK? TSO04140
BNE SSFINDL2 NO, THEN FOUND END OF DSN TSO04150
BCTR R5,0 DECREMENT PTR TSO04160
BCT R4,SSFINDL1 LOOP TILL FOUND TSO04170
WRTERM 'Dsname cannot be entirely blank' TSO04180
B PROMPT TSO04190
SSFINDL2 LR R3,R5 REMEMBER END OF DSN TSO04200
LA R2,2 TRY TO FIND 2 LEVELS TSO04210
SSFINDL3 CLI 0(R5),C'.' IS IT A DOT? TSO04220
BE SSFINDL4 YES, THEN HANDLE IT TSO04230
SSFINDL5 BCTR R5,0 DECREMENT PTR TSO04240
BCT R4,SSFINDL3 LOOP TILL FOUND TSO04250
B SSFINDE BR IF FRONT OF DSN TSO04260
SSFINDL4 BCT R2,SSFINDL5 FIND ANOTHER LEVEL TSO04270
SSFINDE MVC FILNAM,=CL80' ' BLANK FILNAM TSO04280
LA R5,1(,R5) MOVE TO FRONT OF LEVEL TSO04290
SR R3,R5 FIND LENGTH TO MOVE TSO04300
CH R3,=H'17' TRUNC IF TOO LONG TSO04310
BNH *+8 NOT TOO LONG TSO04320
LA R3,=H'17' FORCE MAX LENGTH TSO04330
MVC FILNAM(*-*),0(R5) MOVE INSTRUCTION FOR EXECUTE TSO04340
EX R3,*-6 GO MOVE THE DATA TSO04350
STH R3,FILNAML SAVE LENGTH - 1 TSO04360
MVC DDNAME(8),=CL8'KERIN' TSO04370
MVC DISP1(4),=F'2' DISP=SHR TSO04380
MVC DISP2(4),=F'3' KEEP TSO04390
MVC INOUT(4),=F'0' INPUT TSO04400
LA R1,DYNAPARM TSO04410
L R15,=V(DYNALC) GET EMTRY POINT TSO04420
BALR R14,R15 DO IT TSO04430
ICM R1,B'1111',DYNALCRC GET RETURN CODE TSO04440
BNZ PROMPT TSO04450
* TSO04460
* open the users data set TSO04470
* TSO04480
OPEN (KERIN,(INPUT)) TSO04490
TM KERIN+(DCBOFLGS-IHADCB),DCBOFOPN TSO04500
BO GBOPNB TSO04510
WRTERM 'Open for dataset failed.' TSO04520
B PROMPT TSO04530
GBOPNB DS 0H TSO04540
TM KERIN+(DCBRECFM-IHADCB),DCBRECV IS RECFM=V TSO04550
BO SSDELAY YES, THEN WAIT TSO04560
TM KERIN+(DCBRECFM-IHADCB),DCBRECF IS RECFM=F TSO04570
BO SSDELAY YES, THEN WAIT TSO04580
WRTERM 'Invalid RECFM, only fixed and variable supported' TSO04590
CLOSE KERIN TSO04600
B PROMPT TSO04610
SSDELAY DS 0H TSO04620
MVC WRKBUFF(37),=C'Waiting ..... seconds before sending.' TSO04630
L R1,DELAY TSO04640
SR R0,R0 TSO04650
D R0,=F'100' TSO04660
BINCVRT R1,WRKBUFF+7,DBLWRK TSO04670
TPUT WRKBUFF,37 TSO04680
STIMER WAIT,BINTVL=DELAY TSO04690
B SSWITCH TSO04700
ERR WRTERM 'Invalid command' TSO04710
B PROMPT INVALID COMMAND - TRY AGAIN TSO04720
SPACE 3 TSO04730
SSWITCH EQU * TSO04740
L R15,=A(SEND) TSO04750
BALR R14,R15 CALL SEND PORTION TSO04760
LTR R5,R15 CHECK RETURN CODE TSO04770
BNZ LINON TSO04780
MVI ERRNUM,X'FF' WORKED OK TSO04790
LINON DS 0H TSO04800
* TSO04810
* close any open data sets. TSO04820
* TSO04830
CLOSE (KERIN,,KEROUT) TSO04840
MVC OLDERR(1),ERRNUM ERROR SETTING OF THIS RUN TSO04850
LTR R5,R5 CHECK THE RETCODE TSO04860
BZ PROMPT ALL OKAY TSO04870
WRTERM 'Error in sending file. Try again.' TSO04880
B PROMPT ERROR - TRY AGAIN TSO04890
********************************************************************** TSO04900
* PROCESS SET COMMAND * TSO04910
********************************************************************** TSO04920
STSWITCH EQU * TSO04930
L R15,=A(SET) TSO04940
BALR R14,R15 CALL "SET" SUBROUTINE TSO04950
LTR R15,R15 CHECK RETCODE TSO04960
BZ PROMPT TSO04970
WRTERM 'Illegal Set Command' TSO04980
B PROMPT TSO04990
********************************************************************** TSO05000
* PROCESS SHOW COMMAND * TSO05010
********************************************************************** TSO05020
SHOSW EQU * TSO05030
L R15,=A(SHOW) TSO05040
BALR R14,R15 CALL "SHOW" SUBROUTINE TSO05050
LTR R15,R15 CHECK RETCODE TSO05060
BZ PROMPT TSO05070
WRTERM 'Illegal Show Command' TSO05080
B PROMPT TSO05090
********************************************************************** TSO05100
* PROCESS STATUS COMMAND * TSO05110
********************************************************************** TSO05120
STATSW EQU * TSO05130
BXH R7,R8,GIVSTAT NO MORE LEFT TSO05140
L R6,0(R7) PICK UP NEXT OPERAND TSO05150
CLI 0(R6),C'?' NEED HELP? TSO05160
BNE GIVSTAT TSO05170
WRTERM 'Confirm with a carriage return' TSO05180
B PROMPT TSO05190
GIVSTAT CLI OLDERR,X'FF' WAS THERE AN ERROR LAST TIME? TSO05200
BNE FAIL TSO05210
WRTERM 'Kermit completed successfully' TSO05220
B PROMPT TSO05230
FAIL SR R5,R5 TSO05240
IC R5,OLDERR GET OFFSET INTO ERROR TABLE TSO05250
M R4,=F'20' OFFSET := ERRNUM * 20 TSO05260
LA R5,ERRTAB(R5) TSO05270
*G WRTERM (R5),20 PRINT ERROR MSG ON SCREEN TSO05280
TPUT (R5),20 TSO05290
B PROMPT AND LEAVE TSO05300
********************************************************************** TSO05310
* PROCESS HELP COMMAND * TSO05320
********************************************************************** TSO05330
HELPSW BXH R7,R8,GIVHLP NO MORE LEFT TSO05340
L R6,0(R7) PICK UP NEXT OPERAND TSO05350
CLI 0(R6),C'?' NEED HELP? TSO05360
BNE GIVHLP TSO05370
WRTERM 'Confirm with a carriage return' TSO05380
B PROMPT TSO05390
GIVHLP DS 0H TSO05400
WRTERM 'Enter ? at prompt to receive list of commands.' TSO05410
WRTERM 'Enter ? after a command to receive list of operands' TSO05420
B PROMPT TSO05430
********************************************************************** TSO05440
* PROCESS EXIT COMMAND * TSO05450
********************************************************************** TSO05460
LEAVE BXH R7,R8,KRET ANY MORE OPERANDS? TSO05470
L R6,0(,R7) GET ADDRESS OF OPERAND TSO05480
CLI 0(R6),C'?' NEED HELP? TSO05490
BNE KRET NO, JUST LEAVE TSO05500
WRTERM 'Confirm with a carriage return' TSO05510
B PROMPT TSO05520
BADDEV WRTERM 'An Ascii terminal must be used.' TSO05530
B RET TSO05540
NOTCP WRTERM 'KERMIT-TSO must be running as a command processor' TSO05550
WRTERM 'Contact your local systems programmer' TSO05560
B RET TSO05570
KRET EQU * TSO05580
RET EQU * TSO05590
* TSO05600
* close any open data sets. TSO05610
* dynalc has a free=close so..... TSO05620
* TSO05630
TM KERIN+(DCBOFLGS-IHADCB),DCBOFOPN TSO05640
BNO RETGB1 TSO05650
CLOSE KERIN TSO05660
RETGB1 DS 0H TSO05670
TM KEROUT+(DCBOFLGS-IHADCB),DCBOFOPN TSO05680
BNO RETGB2 TSO05690
CLOSE KEROUT TSO05700
RETGB2 DS 0H TSO05710
CLOSE DEBUG TSO05720
L R13,4(R13) TSO05730
L R14,12(R13) TSO05740
LM R0,R12,20(R13) TSO05750
BR R14 TSO05760
KSAVE DS 18F KERMIT'S SAVE AREA TSO05770
LTORG TSO05780
DROP R11 TSO05790
DROP R12 NO LONGER NEED THEM TSO05800
EJECT TSO05810
********************************************************************** TSO05820
* * TSO05830
* ROUTINE TO PROCESS SET COMMAND * TSO05840
* * TSO05850
********************************************************************** TSO05860
SET DS 0H TSO05870
STM R14,R12,12(R13) SAVE CALLER'S REGISTERS TSO05880
BALR R12,0 ESTABLISH ADDRESSABILITY TSO05890
USING *,R12 TSO05900
LA R14,SETSAVE ADDRESS OF MY SAVE AREA TSO05910
ST R13,4(R14) SAVE CALLER'S TSO05920
ST R14,8(R13) TSO05930
LR R13,R14 TSO05940
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA TSO05950
L R11,=A(PARMS) TSO05960
USING PARMS,R11 ESTABLISH ADDRESSABILITY TSO05970
BXH R7,R8,SETHLP TSO05980
L R6,0(R7) PICK UP NEXT OPERAND TSO05990
CLI 0(R6),C'?' NEED HELP ? TSO06000
BNE NOQ TSO06010
SETHLP WRTERM 'Blksize, Debug, Delay, End-of-line, Lrecl,' TSO06020
WRTERM 'Quote, Packet-size, Recfm, Space, Start-of-line' TSO06030
B SETOK TSO06040
********************************************************************** TSO06050
* SET RECFM * TSO06060
********************************************************************** TSO06070
NOQ CLC =C'RE',0(R6) TSO06080
BNE NOREC TSO06090
BXH R7,R8,SETNFM MORE OPERANDS? TSO06100
L R6,0(R7) PICK UP RECORD FORMAT TSO06110
CLI 0(R6),C'?' TSO06120
BNE CHKFM TSO06130
WRTERM 'f or v (default of v)' TSO06140
B SETOK TSO06150
CHKFM CLI 0(R6),C'V' REDUNDANT TSO06160
BE FMSET TSO06170
CLI 0(R6),C'F' FIXED FORMAT? TSO06180
BNE RECERR TSO06190
FMSET MVC RFM(1),0(R6) PICK UP RECFM TSO06200
B SETOK TSO06210
RECERR WRTERM 'Fixed and variable files only' TSO06220
B SETERR TSO06230
********************************************************************** TSO06240
* SET QUOTE * TSO06250
********************************************************************** TSO06260
NOREC CLC =C'QU',0(R6) QUOTE CHARACTER TSO06270
BNE NOQUO TSO06280
BXH R7,R8,SETNFM ANY MORE OPERANDS TSO06290
L R6,0(R7) GET NEXT TOKEN TSO06300
CLI 0(R6),C' ' VALUE NOT SUPPLIED? TSO06310
BNE GIVQ TSO06320
SETNFM WRTERM '?NOT CONFIRMED' TSO06330
B SETERR TSO06340
GIVQ CLC =C'? ',0(R6) TSO06350
BNE GETQUO TSO06360
WRTERM 'a single character' TSO06370
B SETOK TSO06380
GETQUO MVC QUOCHAR(1),0(R6) SET NEW QUOTE CHAR TSO06390
TR QUOCHAR(1),ETOA GET ASCII FORM TSO06400
CLI 1(R6),C' ' IS IT ONLY ONE CHAR? TSO06410
BE ISQOK TSO06420
WRTERM 'one character only' TSO06430
B BADQUO TSO06440
ISQOK CLI QUOCHAR,X'21' CAN'T BE LESS THAN 32 TSO06450
BL BADQUO TSO06460
CLI QUOCHAR,X'7E' CAN'T BE LARGER THAN 126 TSO06470
BH BADQUO TSO06480
CLI QUOCHAR,X'3E' HAS TO BE BETWEEN 32-62 TSO06490
BNH SETOK TSO06500
CLI QUOCHAR,X'60' OR BETWEEN 96-126 TSO06510
BNL SETOK TSO06520
BADQUO WRTERM 'Must fall between 41-76,140,or 173-176 (octal).' TSO06530
MVC QUOCHAR(1),DQUOTE RESET VALUE, JUST IN CASE TSO06540
B SETERR TSO06550
********************************************************************** TSO06560
* SET LRECL * TSO06570
********************************************************************** TSO06580
NOQUO CLC =C'LR',0(R6) LRECL SIZE TSO06590
BNE SETBLK TSO06600
BXH R7,R8,SETNFM ANY MORE OPERANDS TSO06610
L R6,0(R7) GET NEXT TOKEN TSO06620
CLI 0(R6),C'?' HELP ? TSO06630
BNE GETREC TSO06640
WRTERM 'Logical Record Length (default of 80).' TSO06650
B SETOK TSO06660
GETREC CLI 0(R6),C' ' NO VALUE GIVEN TSO06670
BNE CALC TSO06680
WRTERM '?not confirmed' TSO06690
B SETERR TSO06700
CALC CLI 0(R6),X'F0' MUST BE >= TO 0 TSO06710
BL BADREC TSO06720
CLI 0(R6),X'F9' MUST BE <= TO 9 TSO06730
BH BADREC TSO06740
XC PKVAR,PKVAR EMPTY IT OUT TSO06750
SR R4,R4 LENGTH OF NUMBER TSO06760
CLI 1(R6),C' ' TWO DIGITS? TSO06770
BNE CALC2 TSO06780
EX R4,PCK TSO06790
B TST TSO06800
CALC2 LA R4,1(R4) ADD ONE TSO06810
CLI 2(R6),C' ' THREE DIGITS? TSO06820
BNE CALC3 TSO06830
EX R4,PCK TSO06840
B TST TSO06850
CALC3 LA R4,1(R4) IS THERE AN ERROR? TSO06860
CLI 3(R6),C' ' TSO06870
BNE BADREC TSO06880
EX R4,PCK TSO06890
TST CVB R7,PKVAR TSO06900
C R7,=F'255' MAX OF 255 FOR LRECL TSO06910
BH BADREC TSO06920
STC R7,LRECL SET THE LRECL VALUE TSO06930
B SETOK TSO06940
BADREC WRTERM 'A number with a maximum of 255.' TSO06950
B SETERR TSO06960
********************************************************************** TSO06970
* SET BLKSIZE * TSO06980
********************************************************************** TSO06990
SETBLK CLC =C'BL',0(R6) BLOCK SIZE TSO07000
BNE SETSPACE TSO07010
BXH R7,R8,SETNFM ANY MORE OPERANDS TSO07020
L R6,0(R7) GET NEXT TOKEN TSO07030
CLI 0(R6),C'?' HELP ? TSO07040
BNE GETBLK TSO07050
WRTERM 'Blocksize (default of 80).' TSO07060
B SETOK TSO07070
GETBLK CLI 0(R6),C' ' NO VALUE GIVEN TSO07080
BNE BLKCALC TSO07090
WRTERM '?not confirmed' TSO07100
B SETERR TSO07110
BLKCALC XC PKVAR,PKVAR EMPTY IT OUT TSO07120
SR R4,R4 LENGTH OF NUMBER TSO07130
LA R7,5 MAX LENGTH OF NUMBER TSO07140
LR R5,R6 SAVE START OF STRING TSO07150
BLKCALC1 CLI 0(R6),X'F0' MUST BE >= TO 0 TSO07160
BL BADBLK TSO07170
CLI 0(R6),X'F9' MUST BE <= TO 9 TSO07180
BH BADBLK TSO07190
CLI 1(R6),C' ' FOUND LAST DIGIT? TSO07200
BE BLKCALC2 TSO07210
LA R4,1(R4) COUNT NUMBER OF DIGITS TSO07220
LA R6,1(R6) POINT TO NEXT DIGIT TSO07230
BCT R7,BLKCALC1 KEEP CHECKING TSO07240
B BADBLK TSO07250
BLKCALC2 EX R4,BLKPCK TSO07260
B BLKTST TSO07270
BLKTST CVB R7,PKVAR TSO07280
C R7,=F'32767' MAX OF 32767 FOR BLKSIZE TSO07290
BH BADBLK TSO07300
STH R7,BLKSIZE SET THE BLKSIZE TSO07310
B SETOK TSO07320
BADBLK WRTERM 'A number with a maximum of 32767' TSO07330
B SETERR TSO07340
********************************************************************** TSO07350
* SET TRACK ALLOCATION * TSO07360
********************************************************************** TSO07370
SETSPACE CLC =C'SP',0(R6) BLOCK SIZE TSO07380
BNE SETEOL TSO07390
BXH R7,R8,SETNFM ANY MORE OPERANDS TSO07400
L R6,0(R7) GET NEXT TOKEN TSO07410
CLI 0(R6),C'?' HELP ? TSO07420
BNE GETSPC TSO07430
WRTERM 'Dataset space allocation (default of 5 tracks).' TSO07440
B SETOK TSO07450
GETSPC CLI 0(R6),C' ' NO VALUE GIVEN TSO07460
BNE SPCCALC TSO07470
WRTERM '?not confirmed' TSO07480
B SETERR TSO07490
SPCCALC XC PKVAR,PKVAR EMPTY IT OUT TSO07500
SR R4,R4 LENGTH OF NUMBER TSO07510
LA R7,5 MAX LENGTH OF NUMBER TSO07520
LR R5,R6 SAVE START OF STRING TSO07530
SPCCALC1 CLI 0(R6),X'F0' MUST BE >= TO 0 TSO07540
BL BADSPC TSO07550
CLI 0(R6),X'F9' MUST BE <= TO 9 TSO07560
BH BADSPC TSO07570
CLI 1(R6),C' ' FOUND LAST DIGIT? TSO07580
BE SPCCALC2 TSO07590
LA R4,1(R4) COUNT NUMBER OF DIGITS TSO07600
LA R6,1(R6) POINT TO NEXT DIGIT TSO07610
BCT R7,SPCCALC1 KEEP CHECKING TSO07620
B BADSPC TSO07630
SPCCALC2 EX R4,SPCPCK TSO07640
B SPCTST TSO07650
SPCTST CVB R7,PKVAR TSO07660
C R7,=F'99999' MAX OF 99999 FOR SPACE TSO07670
BH BADSPC TSO07680
ST R7,TRACK SET THE ALLOCATION TSO07690
B SETOK TSO07700
BADSPC WRTERM 'A number with a maximum of 99999' TSO07710
B SETERR TSO07720
********************************************************************** TSO07730
* SET END-OF-LINE CHARACTER * TSO07740
********************************************************************** TSO07750
SETEOL CLC =C'EN',0(R6) EOL CHARACTER TSO07760
BNE NOEND TSO07770
BXH R7,R8,SETNFM ANY MORE OPERANDS TSO07780
L R6,0(R7) GET NEXT TOKEN TSO07790
CLI 0(R6),C' ' NOT DATA TSO07800
BNE EOLCHAR TSO07810
WRTERM '?not confirmed' TSO07820
B SETERR TSO07830
EOLCHAR CLI 0(R6),C'?' NEED HELP? TSO07840
BNE GETEOL TSO07850
WRTERM 'A two digit number between 00 and 31 (dec).' TSO07860
B SETOK TSO07870
GETEOL CLI 0(R6),X'F0' MUST BE >= TO 0 TSO07880
BL BADEOL TSO07890
CLI 0(R6),X'F9' MUST BE <= TO 9 TSO07900
BH BADEOL TSO07910
XC PKVAR,PKVAR USE TO CONVERT VALUE TSO07920
CLI 1(R6),C' ' INPUT MUST BE TWO CHARS TSO07930
BE BADEOL TSO07940
CLI 2(R6),C' ' TWO CHARS, AT MAX TSO07950
BNE BADEOL TSO07960
PACK PKVAR(8),0(2,R6) PICK UP TWO CHARACTERS TSO07970
CVB R7,PKVAR PUT PACKED DECIMAL INTO REG TSO07980
C R7,=F'31' MAX OF 31 DECIMAL TSO07990
BH BADEOL TSO08000
STC R7,SEOL SET SEND EOL VALUE TSO08010
B SETOK TSO08020
BADEOL WRTERM 'Must be a two digit value less than 31 (dec).' TSO08030
B SETERR TSO08040
********************************************************************** TSO08050
* SET PACKET-SIZE * TSO08060
********************************************************************** TSO08070
NOEND CLC =C'PA',0(R6) CHANGE RECEIVE PACKET SIZE TSO08080
BNE NOPAC TSO08090
BXH R7,R8,SETNFM ANY MORE OPERANDS TSO08100
L R6,0(R7) GET NEXT TOKEN TSO08110
CLI 0(R6),C' ' NO DATA TSO08120
BNE GETPAC TSO08130
WRTERM '?not confirmed' TSO08140
B SETERR TSO08150
GETPAC CLI 0(R6),C'?' NEED HELP? TSO08160
BNE CALC4 TSO08170
WRTERM 'Receive packet size (range: 26-94 decimal).' TSO08180
B SETOK TSO08190
CALC4 CLI 0(R6),X'F0' MUST BE >= TO 0 TSO08200
BL BADPAC TSO08210
CLI 0(R6),X'F9' MUST BE <= TO 9 TSO08220
BH BADPAC TSO08230
XC PKVAR,PKVAR USE TO CONVERT VALUE TSO08240
CLI 1(R6),C' ' INPUT MUST BE TWO CHARS TSO08250
BE BADPAC TSO08260
CLI 2(R6),C' ' TWO CHARS, AT MAX TSO08270
BNE BADPAC TSO08280
PACK PKVAR(8),0(2,R6) PICK UP TWO CHARS TSO08290
CVB R7,PKVAR PUT PACKED DECIMAL INTO REG TSO08300
C R7,=F'26' THIS IS MIN TSO08310
BL BADPAC TSO08320
C R7,MAXPACK THIS IS THE MAX TSO08330
BH BADPAC TSO08340
ST R7,RPSIZ USE THIS VALUE NOW TSO08350
B SETOK TSO08360
BADPAC WRTERM 'Must be between 26-94 (decimal).' TSO08370
B SETERR TSO08380
********************************************************************** TSO08390
* SET DEBUG ON|OFF * TSO08400
********************************************************************** TSO08410
NOPAC CLC =C'DEB',0(R6) IS THIS DEBUG? TSO08420
BNE SETSOH NO, THEN SEE IF SET SOH TSO08430
BXH R7,R8,SETNFM ANY MORE OPERANDS TSO08440
L R6,0(R7) GET NEXT TOKEN TSO08450
CLI 0(R6),C' ' IS THERE AN OPERAND? TSO08460
BE DEBERR NO, THEN ASK FOR ONE. TSO08470
CLC =C'ON',0(R6) IS IT TIME TO TURN ON TSO08480
BE DEBON YES, OPEN FILE TSO08490
CLC =C'OF',0(R6) IS IT TIME TO TURN OFF TSO08500
BE DEBOFF YES, CLOSE FILE TSO08510
B DEBERR YES, GIVE MESSAGE TSO08520
DEBERR WRTERM 'Command is SET DEBUG ON | OFF' TSO08530
B SETERR TSO08540
DEBON OPEN (DEBUG,(OUTPUT)) TSO08550
TM DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN IS IT OPEN? TSO08560
BO SETOK TSO08570
WRTERM 'Unable to open debug file, debug disabled.' TSO08580
B SETERR TSO08590
DEBOFF CLOSE DEBUG TSO08600
B SETOK TSO08610
********************************************************************** TSO08620
* SET START-OF-HEADER CHARACTER * TSO08630
********************************************************************** TSO08640
SETSOH CLC =C'ST',0(R6) SOH CHARACTER TSO08650
BNE NOSOH NO, THEN TRY DELAY TSO08660
BXH R7,R8,SETNFM ANY MORE OPERANDS TSO08670
L R6,0(R7) GET NEXT TOKEN TSO08680
CLI 0(R6),C' ' NOT DATA TSO08690
BNE SOHCHAR TSO08700
WRTERM '?not confirmed' TSO08710
B SETERR TSO08720
SOHCHAR CLI 0(R6),C'?' NEED HELP? TSO08730
BNE GETSOH TSO08740
WRTERM 'A two digit number between 00 and 31 (dec).' TSO08750
B SETOK TSO08760
GETSOH CLI 0(R6),X'F0' MUST BE >= TO 0 TSO08770
BL BADSOH TSO08780
CLI 0(R6),X'F9' MUST BE <= TO 9 TSO08790
BH BADSOH TSO08800
XC PKVAR,PKVAR USE TO CONVERT VALUE TSO08810
CLI 1(R6),C' ' INPUT MUST BE TWO CHARS TSO08820
BE BADSOH TSO08830
CLI 2(R6),C' ' TWO CHARS, AT MAX TSO08840
BNE BADSOH TSO08850
PACK PKVAR(8),0(2,R6) PICK UP TWO CHARACTERS TSO08860
CVB R7,PKVAR PUT PACKED DECIMAL INTO REG TSO08870
C R7,=F'31' MAX OF 31 DECIMAL TSO08880
BH BADSOH ERROR, TOO BIG TSO08890
STC R7,SSOH SET SEND SOH VALUE TSO08900
STC R7,RSOH SET RECEIVE SOH VALUE TSO08910
B SETOK TSO08920
BADSOH WRTERM 'Must be a two digit value less than 31 (dec).' TSO08930
B SETERR TSO08940
********************************************************************** TSO08950
* SET DELAY VALUE * TSO08960
********************************************************************** TSO08970
NOSOH CLC =C'DEL',0(R6) CHANGE RECEIVE PACKET SIZE TSO08980
BNE SETERR TSO08990
BXH R7,R8,SETNFM ANY MORE OPERANDS TSO09000
L R6,0(R7) GET NEXT TOKEN TSO09010
CLI 0(R6),C' ' NO DATA TSO09020
BNE GETDELAY TSO09030
WRTERM '?not confirmed' TSO09040
B SETERR TSO09050
GETDELAY CLI 0(R6),C'?' NEED HELP? TSO09060
BNE DLYCALC TSO09070
WRTERM 'Receive packet size (range: 26-94 decimal).' TSO09080
B SETOK TSO09090
DLYCALC XC PKVAR,PKVAR EMPTY IT OUT TSO09100
SR R4,R4 LENGTH OF NUMBER TSO09110
LA R7,5 MAX LENGTH OF NUMBER TSO09120
LR R5,R6 SAVE START OF STRING TSO09130
DLYCALC1 CLI 0(R6),X'F0' MUST BE >= TO 0 TSO09140
BL BADDELAY TSO09150
CLI 0(R6),X'F9' MUST BE <= TO 9 TSO09160
BH BADDELAY TSO09170
CLI 1(R6),C' ' FOUND LAST DIGIT? TSO09180
BE DLYCALC2 TSO09190
LA R4,1(R4) COUNT NUMBER OF DIGITS TSO09200
LA R6,1(R6) POINT TO NEXT DIGIT TSO09210
BCT R7,DLYCALC1 KEEP CHECKING TSO09220
B BADDELAY TSO09230
DLYCALC2 EX R4,DLYPCK TSO09240
B DLYTST TSO09250
DLYTST CVB R7,PKVAR TSO09260
LTR R7,R7 THIS IS MIN TSO09270
BNP BADDELAY TSO09280
C R7,=F'99999' THIS IS THE MAX TSO09290
BH BADDELAY TSO09300
MH R7,=H'100' MAKE IT 100THS OF SECONDS TSO09310
ST R7,DELAY USE THIS VALUE NOW TSO09320
B SETOK TSO09330
BADDELAY WRTERM 'Must be between 1-99999 (DECIMAL).' TSO09340
B SETERR TSO09350
SETERR LA R15,4 SET A NON-ZERO RETCODE TSO09360
B SETRET TSO09370
SETOK SR R15,R15 RETCODE OF 0 TSO09380
* TSO09390
SETRET L R13,4(R13) TSO09400
L R14,12(R13) TSO09410
LM R0,R12,20(R13) TSO09420
BR R14 TSO09430
SETSAVE DS 18F TSO09440
PCK PACK PKVAR(8),0(0,R6) TSO09450
BLKPCK PACK PKVAR(8),0(0,R5) TSO09460
SPCPCK PACK PKVAR(8),0(0,R5) TSO09470
DLYPCK PACK PKVAR(8),0(0,R5) TSO09480
LTORG TSO09490
DROP R11 TSO09500
DROP R12 TSO09510
EJECT TSO09520
********************************************************************** TSO09530
* * TSO09540
* ROUTINE TO PROCESS SHOW COMMAND * TSO09550
* * TSO09560
********************************************************************** TSO09570
SHOW DS 0H TSO09580
STM R14,R12,12(R13) SAVE CALLER'S REGISTERS TSO09590
BALR R12,0 ESTABLISH ADDRESSABILITY TSO09600
USING *,R12 TSO09610
LA R14,SHOWSAVE ADDRESS OF MY SAVE AREA TSO09620
ST R13,4(R14) SAVE CALLER'S TSO09630
ST R14,8(R13) TSO09640
LR R13,R14 TSO09650
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA TSO09660
L R11,=A(PARMS) TSO09670
USING PARMS,R11 ESTABLISH ADDRESSABILITY TSO09680
BXH R7,R8,SHONFM ANY MORE OPERANDS TSO09690
L R6,0(R7) GET NEXT TOKEN TSO09700
CLI 0(R6),C'?' NEED HELP ? TSO09710
BNE SHOREC TSO09720
WRTERM 'State' TSO09730
B SHOWOK TSO09740
SHONFM WRTERM '?NOT CONFIRMED' TSO09750
B SHOWERR TSO09760
SHOREC CLI 0(R6),C'S' IS THIS SHOW STATE TSO09770
BNE SHOWERR TSO09780
MVC WRKBUFF(18),=C'Record format is .' TSO09790
MVC WRKBUFF+17(1),RFM TSO09800
TPUT WRKBUFF,18 TSO09810
TR QUOCHAR(1),ATOE GET EBCDIC VERSION TSO09820
MVC WRKBUFF(20),=C'Quote character is .' TSO09830
MVC WRKBUFF+19(1),QUOCHAR TSO09840
TPUT WRKBUFF,20 TSO09850
TR QUOCHAR(1),ETOA KEEP THE ASCII FORM AROUND TSO09860
SR R4,R4 ZERO IT OUT TSO09870
IC R4,LRECL TSO09880
MVC WRKBUFF(8),=C'Lrecl is' TSO09890
BINCVRT R4,WRKBUFF+8,DBLWRK TSO09900
TPUT WRKBUFF,14 TSO09910
LH R4,BLKSIZE TSO09920
MVC WRKBUFF(10),=C'Blksize is' TSO09930
BINCVRT R4,WRKBUFF+10,DBLWRK TSO09940
TPUT WRKBUFF,16 TSO09950
L R4,TRACK TSO09960
MVC WRKBUFF(32),=C'Space allocation is ..... tracks' TSO09970
BINCVRT R4,WRKBUFF+19,DBLWRK TSO09980
TPUT WRKBUFF,32 TSO09990
SR R4,R4 ZERO IT OUT TSO10000
IC R4,SSOH TSO10010
MVC WRKBUFF(44),=C'Start-of-header character is ..... (decimal)' TSO10020
BINCVRT R4,WRKBUFF+28,DBLWRK TSO10030
TPUT WRKBUFF,44 TSO10040
SR R4,R4 ZERO IT OUT TSO10050
IC R4,SEOL TSO10060
MVC WRKBUFF(40),=C'End-of-line character is ..... (decimal)' TSO10070
BINCVRT R4,WRKBUFF+24,DBLWRK TSO10080
TPUT WRKBUFF,40 TSO10090
MVC WRKBUFF(38),=C'Receive packet size is ..... (decimal)' TSO10100
L R1,RPSIZ TSO10110
BINCVRT R1,WRKBUFF+22,DBLWRK TSO10120
TPUT WRKBUFF,38 TSO10130
MVC WRKBUFF(28),=C'Delay value is ..... seconds' TSO10140
L R1,DELAY TSO10150
SR R0,R0 TSO10160
D R0,=F'100' TSO10170
BINCVRT R1,WRKBUFF+14,DBLWRK TSO10180
TPUT WRKBUFF,28 TSO10190
MVC WRKBUFF(9),=C'Debug is ' TSO10200
MVC WRKBUFF+9(3),=C'off' TSO10210
TM DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN IS IT OPEN? TSO10220
BZ SHOWDBG TSO10230
MVC WRKBUFF+9(3),=C'on ' TSO10240
SHOWDBG TPUT WRKBUFF,12 TSO10250
B SHOWOK TSO10260
SHOWERR LA R15,4 SET A NON-ZERO RETCODE TSO10270
B SHOWRET TSO10280
SHOWOK SR R15,R15 ZERO RETCODE TSO10290
* TSO10300
SHOWRET L R13,4(R13) TSO10310
L R14,12(R13) TSO10320
LM R0,R12,20(R13) TSO10330
BR R14 TSO10340
SHOWSAVE DS 18F TSO10350
LTORG TSO10360
DROP R11 TSO10370
DROP R12 TSO10380
* TSO10390
EJECT TSO10400
********************************************************************** TSO10410
* * TSO10420
* ROUTINE TO INITIALIZE PARAMETER AREA * TSO10430
* * TSO10440
********************************************************************** TSO10450
INIT DS 0H TSO10460
STM R14,R12,12(R13) TSO10470
BALR R12,0 TSO10480
USING *,R12 TSO10490
LA R14,ISAVE TSO10500
ST R13,4(R14) TSO10510
ST R14,8(R13) TSO10520
LR R13,R14 TSO10530
* TSO10540
* INITIALIZE VARIABLES THAT GET CHANGED DURING EXECUTION TSO10550
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA LIST TSO10560
L R11,=A(PARMS) TSO10570
USING PARMS,R11 TSO10580
XC SNDPKT,SNDPKT CLEAR OUT THESE BUFFERS TSO10590
XC RECPKT,RECPKT TSO10600
XC INPUT,INPUT TSO10610
LA R0,BUF TSO10620
LA R1,L'BUF ; CLEAR OUT THE BUFFER. TSO10630
SR R15,R15 TSO10640
MVCL R0,R14 TSO10650
LA R0,RBUF TSO10660
LA R1,L'RBUF TSO10670
SR R15,R15 TSO10680
MVCL R0,R14 TSO10690
XC SDAT,SDAT TSO10700
XC RDAT,RDAT TSO10710
XC N,N SET VARIABLES TO ZERO TSO10720
XC NUM,NUM TSO10730
XC LSDAT,LSDAT TSO10740
XC LRDAT,LRDAT TSO10750
MVI FLAGS,X'00' CLEAR ALL FLAGS TSO10760
XC SAVPL,SAVPL TSO10770
XC RSAVPL,RSAVPL TSO10780
XC NUMTRY,NUMTRY TSO10790
MVC FILNAM,=18X'20' BLANK OUT FILNAM & NAME TSO10800
MVC NAME,=18X'20' TSO10810
MVI PREV,X'00' TSO10820
MVI ERRNUM,X'FF' SET TO NO ERROR FOR NOW TSO10830
MVI OLDERR,X'FF' SAME HERE TSO10840
XC PKVAR,PKVAR ZERO IT OUT TSO10850
XC OLDTRY,OLDTRY TSO10860
XC SPSIZ,SPSIZ TSO10870
XC SIZE,SIZE TSO10880
XC TEMP,TEMP TSO10890
XC STORLOC,STORLOC TSO10900
MVC DELAY,DDELAY SET DEFAULT DELAY TSO10910
MVC LRECL(1),DLRECL SET DEFAULTS, JUST IN CASE TSO10920
MVC BLKSIZE(2),DBLKSIZE SET DEFAULTS, JUST IN CASE TSO10930
MVC TRACK,DTRACK DEFAULT SPACE OF 5 TRACKS TSO10940
MVC RFM(1),DRECFM TSO10950
MVC QUOCHAR(1),DQUOTE TSO10960
MVC RQUO(1),DQUOTE TSO10970
MVC REOL(1),DEOL TSO10980
MVC SEOL(1),DEOL TSO10990
MVC SSOH(1),DSOH TSO11000
MVC RSOH(1),DSOH TSO11010
MVI STATE,C' ' TSO11020
MVI STYPE,C' ' TSO11030
MVI RTYPE,C' ' TSO11040
* TSO11050
INITRET L R13,4(R13) TSO11060
L R14,12(R13) TSO11070
LM R0,R12,20(R13) TSO11080
BR R14 TSO11090
ISAVE DS 18F TSO11100
LTORG TSO11110
DROP R11 TSO11120
DROP R12 TSO11130
EJECT TSO11140
********************************************************************** TSO11150
* * TSO11160
* ROUTINE TO PROCESS SEND COMMAND * TSO11170
* * TSO11180
********************************************************************** TSO11190
SEND DS 0H TSO11200
STM R14,R12,12(R13) SAVE CALLER'S REGISTERS TSO11210
BALR R12,0 ESTABLISH ADDRESSABILITY TSO11220
USING *,R12 TSO11230
LA R14,SENDSAVE ADDRESS OF MY SAVE AREA TSO11240
ST R13,4(R14) SAVE CALLER'S TSO11250
ST R14,8(R13) TSO11260
LR R13,R14 TSO11270
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA TSO11280
L R11,=A(PARMS) TSO11290
USING PARMS,R11 ESTABLISH ADDRESSABILITY TSO11300
MVI STATE,C'S' TSO11310
SR R3,R3 TSO11320
ST R3,N TSO11330
ST R3,NUMTRY TSO11340
OKSND TM FLAGS,FLG1 IS THIS THE FIRST FILE? TSO11350
BNO SLOOP TSO11360
NI FLAGS,X'FF'-FLG1 TURN OFF FIRST FILE FLAG TSO11370
********************************************************************** TSO11380
* MAIN SEND LOOP * TSO11390
********************************************************************** TSO11400
SLOOP CLI STATE,C'D' SEND DATA STATE TSO11410
BE SDATA TSO11420
CLI STATE,C'F' SEND FILE STATE TSO11430
BE SFILE TSO11440
CLI STATE,C'S' SEND INIT STATE TSO11450
BE SINIT TSO11460
CLI STATE,C'Z' END OF FILE STATE TSO11470
BE SEOF TSO11480
CLI STATE,C'B' SEND BREAK STATE TSO11490
BE SBREAK TSO11500
CLI STATE,C'C' COMPLETE STATE TSO11510
BE COMPLETE TSO11520
CLI STATE,C'A' ABORT STATE TSO11530
BE ABORT ERROR - GO TO ABORT STATE TSO11540
MVI ERRNUM,X'02' UNRECOGNIZED STATE TSO11550
B ABORT OTHERWISE, DIE TSO11560
********************************************************************** TSO11570
* CREATE AND SEND INITIALIZATION PACKET * TSO11580
********************************************************************** TSO11590
SINIT CLC NUMTRY,IMXTRY SEE IF CAN SEND TSO11600
BL OK1 YES WE CAN TSO11610
MVI STATE,C'A' NOPE, GO INTO ABORT STATE TSO11620
B SLOOP TSO11630
OK1 L R5,SPACE MAKE CHARACTER PRINTABLE TSO11640
A R5,RPSIZ ADD REC PACKET SIZE TSO11650
STC R5,SDAT ADD SIZE INFO TO BUFFER TSO11660
L R5,SPACE TSO11670
A R5,=F'8' 8 FOR TIMEOUT TSO11680
STC R5,SDAT+1 TSO11690
L R5,SPACE SEND ZERO + " " FOR NPAD TSO11700
STC R5,SDAT+2 WE'RE THE SLOW GUYS TSO11710
SR R5,R5 PAD WITH NULLS TSO11720
L R3,O1H TSO11730
XR R5,R3 CTL FUNCTION (XOR WITH 64) TSO11740
STC R5,SDAT+3 DON'T NEED PADCHAR EITHER TSO11750
SR R5,R5 ZERO IT OUT FOR NEXT TWO GUYS TSO11760
IC R5,REOL EOL CHAR I NEED TSO11770
A R5,SPACE MAKE PRINTABLE TSO11780
STC R5,SDAT+4 TSO11790
IC R5,QUOCHAR MY QUOTE CHAR TSO11800
STC R5,SDAT+5 TSO11810
L R3,NUMTRY TSO11820
LA R3,1(R3) INCREMENT TRIAL COUNTER TSO11830
ST R3,NUMTRY TSO11840
MVI STYPE,AS PACKET TYPE = SEND INITIATE TSO11850
MVC LSDAT(4),=F'6' BUFFER SIZE FOR THIS SEND TSO11860
L R4,DSSIZ GET DEFAULT SPSIZ TSO11870
S R4,FIVE FOR NOW, USE DEFAULT SPSIZ.... TSO11880
ST R4,SIZE ....TO SET VALUE OF SIZE TSO11890
L R15,=A(SPACK) GET ADDRESS OF ROUTINE 'SPACK' TSO11900
BALR 14,15 SAVE * AND GO TO SPACK TSO11910
CLI STATE,C'A' TSO11920
BE ABORT TSO11930
L 15,=A(RPACK) GET ADDRESS OF 'RPACK' TSO11940
BALR 14,15 SAVE * AND GO TO RPACK TSO11950
CLI RTYPE,AE ERROR PACKET? TSO11960
BNE Y1 NO, THEN MAYBE AN ACK TSO11970
MVI ERRNUM,X'0A' MICRO DIED TSO11980
MVI STATE,C'A' AND DIE TSO11990
B SLOOP TSO12000
Y1 CLI RTYPE,AY SEE IF GOT ACK TSO12010
BNE N1 MAYBE IT'S 'N' TSO12020
CLC N,NUM CHECK MESSAGE NUMBERS TSO12030
BE AOK1 TSO12040
MVI ERRNUM,X'08' PACKET LOST TSO12050
B SLOOP TSO12060
AOK1 SR R4,R4 ZERO OUT REGISTER TSO12070
IC R4,RDAT USE SPSIZ THE MICRO WANTS TSO12080
S R4,SPACE SUBTRACT THE ' ' TSO12090
C R4,=F'26' BUFFER HAS TO BE >= 26 TSO12100
BNL CH1 SO FAR, SO GOOD TSO12110
MVI STATE,C'A' ABORT THEN TSO12120
MVI ERRNUM,X'00' INVALID DATA-PACKET-SIZE ERROR TSO12130
B SLOOP TSO12140
CH1 C R4,MAXPACK MAX PACKET SIZE TSO12150
BNH CH2 CONTINUE IF <= TO MAX TSO12160
MVI STATE,C'A' DIE TSO12170
MVI ERRNUM,X'00' INVALID DATA-PACKET-SIZE ERROR TSO12180
B SLOOP TSO12190
CH2 STC R4,SPSIZ+3 USE SPSIZ THE MICRO WANTS TSO12200
S R4,FIVE TSO12210
ST R4,SIZE SET SIZE TO SPSIZ-5 TSO12220
CLC LRDAT(4),=F'4' USING DEFAULTS? TSO12230
BNH NOCHG YUP TSO12240
LA R5,RDAT POINTER TO THE BUFFER TSO12250
SR R7,R7 TSO12260
IC R7,4(R5) SEOL MICRO WANTS TSO12270
S R7,SPACE UNCHAR (IE - SUBTRACT SPACE) TSO12280
STC R7,SEOL TSO12290
NOCHG MVI STATE,C'F' PUT INTO SEND FILE STATE TSO12300
XC NUMTRY,NUMTRY RESET TO ZERO TSO12310
L R3,N TSO12320
LA R3,1(R3) ADD ONE TSO12330
ST R3,N STORE VALUE INCREMENTED BY 1 TSO12340
NC N(4),=X'0000003F' MASK TO GET MOD 64 TSO12350
B SLOOP TSO12360
N1 CLI RTYPE,AN SEE IF IT'S 'N' TSO12370
BNE AB1 IF NOT, DIE TSO12380
TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED? TSO12390
BO SLOOP LEAVE ERR MSG AS IS IF I DID TSO12400
MVI ERRNUM,X'09' MICRO NAK'ED TSO12410
B SLOOP TSO12420
AB1 MVI STATE,C'A' ELSE, ABORT TSO12430
MVI ERRNUM,X'07' UNRECOGNIZED PACKET TYPE TSO12440
B SLOOP TSO12450
********************************************************************** TSO12460
* CREATE AND SEND FILE PACKET * TSO12470
********************************************************************** TSO12480
SFILE CLC NUMTRY,MAXTRY EXCEEDED NO. OF TRIES ALLOWED? TSO12490
BL OK2 NOPE, STILL OK TSO12500
MVI STATE,C'A' ABORT IF YES TSO12510
B SLOOP TSO12520
OK2 DS 0H TSO12530
TR FILNAM,ETOA TSO12540
LH R5,FILNAML GET LENGTH OF FILENAME - 1 TSO12550
MVC SDAT(*-*),FILNAM USE FOR EXECUTE TSO12560
EX R5,*-6 GO MOVE FILENAME TO BUFFER TSO12570
LA R5,1(,R5) UP THE FILE LENGTH TO BE EXACT TSO12580
L R3,NUMTRY TSO12590
LA R3,1(R3) INCREMENT TRIAL COUNTER TSO12600
ST R3,NUMTRY TSO12610
MVI STYPE,AF PACKET TYPE = FILE HEADER TSO12620
ST R5,LSDAT SET BUFFER SIZE TSO12630
TR FILNAM,ATOE TSO12640
SNDFIL L R15,=A(SPACK) GET ADDRESS OF 'SPACK' TSO12650
BALR 14,15 SAVE * AND GO TO SPACK TSO12660
CLI STATE,C'A' TSO12670
BE ABORT TSO12680
L 15,=A(RPACK) GET ADDRESS OF 'RPACK' TSO12690
BALR 14,15 SAVE * AND GO TO RPACK TSO12700
CLI RTYPE,AE ERROR PACKET? TSO12710
BNE Y2 MAYBE AN ACK TSO12720
MVI ERRNUM,X'0A' MICRO DIED TSO12730
MVI STATE,C'A' SO WE DO TOO TSO12740
B SLOOP TSO12750
Y2 CLI RTYPE,AY SEE IF GOT ACK TSO12760
BNE N2 MAYBE GOT AN 'N' TSO12770
CLC N,NUM DO WE HAVE THE CORRECT ACK? TSO12780
BE AOK2 TSO12790
MVI ERRNUM,X'08' MISSING A PACKET SOMEWHERE TSO12800
B SLOOP TSO12810
AOK2 MVI STATE,C'D' PREPARE FOR SEND-DATA STATE TSO12820
XC NUMTRY,NUMTRY RESET COUNTER TSO12830
L R3,N TSO12840
LA R3,1(R3) ADD ONE TSO12850
ST R3,N STORE INCREMENTED VALUE TSO12860
NC N(4),=X'0000003F' MASK TO GET MOD 64 TSO12870
L 15,=A(GTCHR) TSO12880
BALR 14,15 DO GET-CHAR AND COME BACK TSO12890
B SLOOP TSO12900
N2 CLI RTYPE,AN TSO12910
BNE AB2 ELSE, DIE TSO12920
TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED? TSO12930
BO SLOOP LEAVE ERR MSG AS IS IF I DID TSO12940
MVI ERRNUM,X'09' MICRO NAK'ED TSO12950
B SLOOP TSO12960
AB2 MVI STATE,C'A' ELSE, ABORT TSO12970
MVI ERRNUM,X'07' UNRECOGNIZED PACKET TYPE TSO12980
B SLOOP TSO12990
********************************************************************** TSO13000
* CREATE AND SEND DATA PACKETS * TSO13010
********************************************************************** TSO13020
SDATA CLC NUMTRY,MAXTRY CAN WE DO IT? TSO13030
BL OK4 YES TSO13040
MVI STATE,C'A' ELSE ABORT TSO13050
B SLOOP TSO13060
OK4 L R3,NUMTRY TSO13070
LA R3,1(R3) INCREMENT COUNTER TSO13080
ST R3,NUMTRY TSO13090
MVI STYPE,AD PACKET TYPE = DATA TSO13100
L R15,=A(SPACK) TSO13110
BALR 14,15 GO TO SPACK AND RETURN TSO13120
CLI STATE,C'A' TSO13130
BE ABORT TSO13140
L 15,=A(RPACK) TSO13150
BALR 14,15 SAME FOR RPACK TSO13160
CLI RTYPE,AE ERROR PACKET? TSO13170
BNE Y4 MAYBE AN ACK TSO13180
MVI ERRNUM,X'0A' MICRO DIED TSO13190
MVI STATE,C'A' SO WE DO TOO TSO13200
B SLOOP TSO13210
Y4 CLI RTYPE,AY SEE IF GOT 'ACK' TSO13220
BNE N4 SEE IF IT'S AN 'N' TSO13230
CLC N,NUM DO WE HAVE THE CORRECT ACK? TSO13240
BE AOK4 TSO13250
MVI ERRNUM,X'08' MISSING A PACKET TSO13260
B SLOOP TSO13270
AOK4 XC NUMTRY,NUMTRY RESET COUNTER TSO13280
L R3,N TSO13290
LA R3,1(R3) INCREMENT COUNTER TSO13300
ST R3,N TSO13310
NC N(4),=X'0000003F' MASK TO GET MOD 64 TSO13320
L 15,=A(GTCHR) TSO13330
BALR 14,15 DO GET-CHAR AND RETURN TSO13340
B SLOOP TSO13350
N4 CLI RTYPE,AN TSO13360
BNE AB4 TSO13370
TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED? TSO13380
BO SLOOP LEAVE ERR MSG AS IS IF I DID TSO13390
MVI ERRNUM,X'09' MICRO NAK'ED TSO13400
B SLOOP TSO13410
AB4 MVI STATE,C'A' TSO13420
MVI ERRNUM,X'07' ILLEGAL PACKET TYPE TSO13430
B SLOOP TSO13440
********************************************************************** TSO13450
* CREATE AND SEND EOF PACKET * TSO13460
********************************************************************** TSO13470
SEOF CLC NUMTRY,MAXTRY CAN WE DO IT? TSO13480
BL OK5 BRANCH IF YES TSO13490
MVI STATE,C'A' ABORT IF NO TSO13500
B SLOOP TSO13510
OK5 L R3,NUMTRY TSO13520
LA R3,1(R3) ADD ONE TSO13530
ST R3,NUMTRY STORE INCREMENTED COUNTER TSO13540
MVI STYPE,AZ PACKET TYPE = EOF TSO13550
XC LSDAT,LSDAT LENGTH OF ZERO TSO13560
L R15,=A(SPACK) TSO13570
BALR 14,15 SAVE * AND GO TO SPACK TSO13580
CLI STATE,C'A' TSO13590
BE ABORT TSO13600
L 15,=A(RPACK) TSO13610
BALR 14,15 SAME FOR RPACK TSO13620
CLI RTYPE,AE ERROR PACKET? TSO13630
BNE Y5 MAYBE AN ACK TSO13640
MVI ERRNUM,X'0A' MICRO DIED TSO13650
MVI STATE,C'A' SO WE DO TOO TSO13660
B SLOOP TSO13670
Y5 CLI RTYPE,AY CHECK FOR 'ACK' TSO13680
BNE N5 MAYBE WAS A 'NAK' TSO13690
CLC N,NUM CORRECT ACK? TSO13700
BE AOK5 TSO13710
MVI ERRNUM,X'08' LOST A PACKET TSO13720
B SLOOP TSO13730
AOK5 L R3,N TSO13740
LA R3,1(R3) ADD ONE TSO13750
ST R3,N STORE VALUE INCREMENTED BY 1 TSO13760
NC N(4),=X'0000003F' MASK TO GET MOD 64 TSO13770
MVI STATE,C'F' SET TO SEND FILE FOR NOW TSO13780
* TSO13790
* TSO13800
* WE JUST PROCESS ONE FILE FOR NOW. TSO13810
* TSO13820
DIEOK MVI STATE,C'B' BREAK CONNECTION TSO13830
B SLOOP TSO13840
N5 CLI RTYPE,AN TSO13850
BNE AB5 DIE IF NOT A NAK TSO13860
TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED? TSO13870
BO SLOOP LEAVE ERR MSG AS IS IF I DID TSO13880
MVI ERRNUM,X'09' MICRO NAK'ED TSO13890
B SLOOP TSO13900
AB5 MVI STATE,C'A' ELSE, ABORT TSO13910
MVI ERRNUM,X'07' UNRECOGNIZED PACKET TYPE TSO13920
B SLOOP TSO13930
********************************************************************** TSO13940
* CREATE AND SEND BREAK PACKET * TSO13950
********************************************************************** TSO13960
SBREAK CLC NUMTRY,MAXTRY OVER OUR LIMIT? TSO13970
BL OK6 BRANCH IF NO TSO13980
MVI STATE,C'A' ABORT IF YES TSO13990
B SLOOP TSO14000
OK6 L R3,NUMTRY TSO14010
LA R3,1(R3) ADD ONE TSO14020
ST R3,NUMTRY INCREMEMTED TRIAL COUNTER TSO14030
MVI STYPE,AB PACKET TYPE = BREAK TSO14040
XC LSDAT,LSDAT LENGTH = ZERO TSO14050
L R15,=A(SPACK) TSO14060
BALR 14,15 SAVE * AND GO TO SPACK TSO14070
CLI STATE,C'A' TSO14080
BE ABORT TSO14090
L 15,=A(RPACK) TSO14100
BALR 14,15 SAVE * AND GO TO RPACK TSO14110
CLI RTYPE,AE ERROR PACKET? TSO14120
BNE Y6 MAYBE AN ACK TSO14130
MVI ERRNUM,X'0A' MICRO DIED TSO14140
MVI STATE,C'A' THEN WE DO TOO TSO14150
B SLOOP TSO14160
Y6 CLI RTYPE,AY CHECK FOR ACK TSO14170
BNE N6 CHECK FOR 'N' TSO14180
CLC N,NUM CORRECT ACK? TSO14190
BE AOK6 TSO14200
MVI ERRNUM,X'08' LOST A PACKET TSO14210
B SLOOP TSO14220
AOK6 MVI STATE,C'C' COMPLETED STATE TSO14230
B SLOOP TSO14240
N6 CLI RTYPE,AN CHECK FOR 'N' TSO14250
BNE AB6 DIE IF NOT A NAK TSO14260
TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED? TSO14270
BO SLOOP LEAVE ERR MSG AS IS IF I DID TSO14280
MVI ERRNUM,X'09' MICRO NAK'ED TSO14290
B SLOOP TSO14300
AB6 MVI STATE,C'A' ELSE,ABORT TSO14310
MVI ERRNUM,X'07' UNRECOGNIZED PACKET TYPE TSO14320
B SLOOP TSO14330
********************************************************************** TSO14340
* CREATE AND SEND ABORT PACKET * TSO14350
********************************************************************** TSO14360
ABORT DS 0H TSO14370
TM FLAGS,FLG1 DYING ON FILE-NOT-FOUND? TSO14380
BO NOERRP IF SO, THEN NO ERROR PACKET TSO14390
CLI ERRNUM,X'0A' DID THE MICRO DIE? TSO14400
BE NOERRP NO ERROR PACKET IF SO TSO14410
MVI STYPE,AE ERROR PACKET TSO14420
MVC LSDAT(4),=F'20' ALL MSGS ARE THIS LONG TSO14430
MVC N(4),NUM SYNCH PACKET NUMBERS TSO14440
SR R5,R5 TSO14450
IC R5,ERRNUM GET RIGHT MESSAGE NUMBER TSO14460
M R4,=F'20' OFFSET := ERRNUM * 20 TSO14470
LA R5,ERRTAB(R5) TSO14480
MVC SDAT(20),0(R5) SPACK NEEDS THE DATA HERE TSO14490
TR SDAT(20),ETOA TSO14500
L R15,=A(SPACK) TSO14510
BALR R14,R15 SEND ERROR PACKET & DIE TSO14520
NOERRP LA R15,4 SET NON-ZERO RETCODE TSO14530
B SENDRET PREPARE TO LEAVE TSO14540
********************************************************************** TSO14550
* PROCESS COMPLETE * TSO14560
********************************************************************** TSO14570
COMPLETE SR R15,R15 ZERO WILL BE RETCODE TSO14580
SENDRET L R13,4(R13) TSO14590
L R14,12(R13) TSO14600
LM R0,R12,20(R13) TSO14610
BR R14 TSO14620
EJECT TSO14630
********************************************************************** TSO14640
* * TSO14650
* ROUTINE TO GET A CHARACTER FROM INPUT BUFFER WILL READ DISK TO * TSO14660
* FILL THE BUFFER. * TSO14670
* * TSO14680
********************************************************************** TSO14690
GTCHR DS 0H TSO14700
TM FLAGS,FLG3 SEE IF THERE'S STUFF IN BUF TSO14710
BO STUFF ONES -> STUFF'S THERE TSO14720
* TSO14730
* GO TO COMMON ROUTINE TO READ SOME BYTES TSO14740
* TSO14750
LA R15,READX TSO14760
BALR R15,R15 TSO14770
* TSO14780
LTR R4,R1 PUT RESULT OF READ IN R4 TSO14790
BZ OK8 TSO14800
C R4,=A(ERCOD) RETCODE OF 12 MEANS EOF TSO14810
BNE ERR1 TRY IT AGAIN TSO14820
MVI STATE,C'Z' MAKE TO EOF STATE TSO14830
BR R14 TSO14840
ERR1 MVI STATE,C'A' ABORT ON FILE SYSTEM ERROR TSO14850
MVI ERRNUM,X'0C' INVALID RECORD LENGTH TSO14860
C R4,=F'8' WAS OUR GUESS RIGHT? TSO14870
BER R14 IF YES, RETURN TSO14880
MVI ERRNUM,X'0D' ELSE, GOT AN I/O ERROR TSO14890
BR R14 TSO14900
OK8 LR R5,R0 GET NUMBER OF BYTES READ IN TSO14910
LR R4,R5 SAVE ALSO IN R4 TSO14920
BCTR R4,0 SUBTRACT 1 FOR EX COMMAND TSO14930
EX R4,TRANS EBCDIC TO ASCII TRANSLATION TSO14940
LA R8,BUF GET LOCATION OF BUFFER INPUT TSO14950
LA R9,BUF(R4) LAST POSITION IN THAT BUFFER TSO14960
X4 CLI 0(R9),X'20' IS THIS A BLANK? TSO14970
BNE X5 NO, FOUND LAST CHAR OF LINE TSO14980
BCTR R9,0 TSO14990
CR R9,R8 TSO15000
BNL X4 FIND LAST CHAR TSO15010
SR R5,R5 ALL BLANKS TSO15020
B FOO TSO15030
X5 SR R9,R8 TSO15040
LR R5,R9 LENGTH OF LINE TSO15050
LA R5,1(R5) ADD ONE TSO15060
FOO LA R9,BUF(R5) FIRST BLANK SPACE AFTER DATA TSO15070
MVC 0(1,R9),=X'0D' ADD ASCII CR TSO15080
LA R9,1(R9) INCREMENT POINTER TSO15090
MVC 0(1,R9),=X'0A' AND ADD ASCII LF TSO15100
LA R5,2(R5) TWO EXTRA BYTES OF DATA NOW TSO15110
ST R5,RECL LRECL + 2 (FOR CRLF) TSO15120
SR R8,R8 ZERO OUT INDEX FOR BUF TSO15130
STUFF SR R9,R9 SAME FOR INDEX FOR SDAT TSO15140
SR R10,R10 CHARACTER COUNTER TSO15150
SR R5,R5 WILL HOLD QUOCHAR TSO15160
IC R5,QUOCHAR TSO15170
L R8,SAVPL WHERE WE LEFT OFF TSO15180
C R8,RECL SEE IF ARE AT LIMIT TSO15190
BNL FULL2 LEAVE IF REACHED OR EXCEEDED TSO15200
SR R7,R7 TSO15210
LOOP IC R7,BUF(R8) PICK UP BYTE TSO15220
CR R7,R5 IS IT THE QUOTE CHARACTER? TSO15230
BE SPECIAL TSO15240
C R7,DEL IS IT THE CHARDEL? TSO15250
BE SPECIAL TSO15260
C R7,SPACE IS IT A CONTROL CHARACTER? TSO15270
BL SPECIAL TSO15280
B ADDIT TSO15290
SPECIAL L R4,SIZE MUNGE VALUE WHILE IN R4 TSO15300
SR R4,R10 FIND DIF BETWWEN THE TWO TSO15310
C R4,TWO SEE IF HAVE AT LEAST 2 BYTES TSO15320
BNL ROOM YES,CAN ADD TSO15330
STC R10,LSDAT+3 SET LSDAT TO VAL OF COUNTER TSO15340
OI FLAGS,FLG3 SET FLAG TO SHOW STUFF'S THERE TSO15350
ST R8,SAVPL SAVE PLACE IN BUF TSO15360
BR 14 LEAVE THIS ROUTINE TSO15370
ROOM LA R4,SDAT(R9) WHERE IT'S GOING TSO15380
MVC 0(1,R4),QUOCHAR MOVE QUOTE CHAR THERE TSO15390
LA R9,1(R9) INCREMENT SDAT COUNTER TSO15400
LA R10,1(R10) INCREMENT CHARACTER COUNTER TSO15410
CR R7,R5 DON'T ADD ^O100 TO THIS TSO15420
BE ADDIT IT'S ALREADY PRINTABLE TSO15430
A R7,O1H ADD ^O100 TO CHAR TSO15440
N R7,=X'0000007F' GET MOD ^O200 TSO15450
ADDIT STC R7,SDAT(R9) ADD THE CHARACTER TSO15460
LA R9,1(R9) INCREMENT SDAT COUNTER TSO15470
LA R8,1(R8) INCREMENT BUF COUNTER TSO15480
LA R10,1(R10) INCREMENT CHARACTER COUNTER TSO15490
C R8,RECL SEE IF REACHED LIMIT TSO15500
BNL FULL2 TSO15510
C R9,SIZE SEE IF REACHED LIMIT TSO15520
BNL FULL TSO15530
B LOOP TSO15540
FULL EQU * TSO15550
STC R10,LSDAT+3 THIS ONE TOO TSO15560
ST R8,SAVPL HERE TOO TSO15570
OI FLAGS,FLG3 TURN ON FLAG - STUFF IN BUF TSO15580
BR 14 TSO15590
FULL2 EQU * TSO15600
STC R10,LSDAT+3 THIS ONE TOO TSO15610
XC SAVPL,SAVPL RESET THIS TSO15620
NI FLAGS,X'FF'-FLG3 TURN OFF LEFTOVER DATA FLAG TSO15630
BR 14 TSO15640
SENDSAVE DS 18F TSO15650
TRANS TR BUF(0),ETOA EBCDIC TO ASCII TRANSLATION TSO15660
TRNS TR SNDPKT(0),ATOE BACK FROM ASCII TO EBCDIC TSO15670
PARSE DC 32X'00' TSO15680
DC X'01' STOP ON A SPACE TSO15690
DC 223X'00' TSO15700
FIRST MVC SDAT(0),FILNAM PICK UP THE FN TSO15710
SECOND MVC 0(0,R7),FILNAM+8 PICK UP FT TSO15720
LTORG TSO15730
DROP R11 TSO15740
DROP R12 DON'T NEED THEM ANYMORE TSO15750
EJECT TSO15760
********************************************************************** TSO15770
* * TSO15780
* ROUTINE TO PROCESS SEND PACKET REQUEST * TSO15790
* * TSO15800
********************************************************************** TSO15810
SPACK DS 0H CSECT TSO15820
STM R14,R12,12(R13) SAVE CALLER'S REGISTERS TSO15830
BALR R12,0 ESTABLISH ADDRESSABILITY TSO15840
USING *,R12 TSO15850
LA R14,SPSAVE ADDRESS OF MY SAVE AREA TSO15860
ST R13,4(R14) SAVE CALLER'S TSO15870
ST R14,8(R13) TSO15880
LR R13,R14 TSO15890
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA TSO15900
L R11,=A(PARMS) TSO15910
USING PARMS,R11 ESTABLISH ADDRESSABILITY TSO15920
SR R9,R9 TSO15930
MVC PHDR,SSOH ADD SOH TO PACKET TSO15940
CLC LSDAT,SIZE NEED DATA SIZE <= SPSIZ-5 TSO15950
BNH FINE TSO15960
MVI ERRNUM,X'00' DATA SIZE EXCEEDS MAX LIMIT TSO15970
MVI STATE,C'A' ABORT ON THIS TSO15980
B SPRET TSO15990
FINE L R4,=F'35' USE ^o43 TO OFFSET DATA TSO16000
A R4,LSDAT ADD IT TO LSDAT TSO16010
STC R4,PLEN TSO16020
AR R9,R4 AND THEN ADD IT TO CHECKSUM TSO16030
CLC N,ZERO CHECK IF N IS VALID TSO16040
BNL T1 OK IF >= TO 0 TSO16050
MVI ERRNUM,X'01' ILLEGAL MESSAGE NUMBER TSO16060
MVI STATE,C'A' TSO16070
B SPRET TSO16080
T1 CLC N,O1H SEE IF IS <= OCTAL 100 TSO16090
BNH T2 TSO16100
MVI ERRNUM,X'01' ILLEGAL MESSAGE NUMBER TSO16110
MVI STATE,C'A' TSO16120
B SPRET TSO16130
T2 L R4,SPACE OFFSET THIS VALUE TOO TSO16140
A R4,N ADD IT TO N TSO16150
ST R4,TEMP TSO16160
MVC PNUM(1),TEMP+3 TSO16170
A R9,TEMP AND ADD TO CHECKSUM TSO16180
CLI STYPE,X'41' ASCII 'A' TSO16190
BL T3 CAN'T BE LESS THAN THIS TSO16200
CLI STYPE,X'5A' ASCII 'Z' TSO16210
BNH T4 CAN'T BE GREATER TSO16220
T3 MVI ERRNUM,X'07' ILLEGAL PACKET TYPE TSO16230
MVI STATE,C'A' DIE ON THIS TSO16240
B SPRET TSO16250
T4 MVC PTYPE(1),STYPE ADD MESSAGE TYPE TSO16260
SR R2,R2 ZERO IT OUT TSO16270
IC R2,STYPE TSO16280
AR R9,R2 ADD TO CHECKSUM TSO16290
L R6,LSDAT HOW MUCH DATA TSO16300
LTR R6,R6 TEST IT OUT TSO16310
BZ NODAT TSO16320
SR R5,R5 USE TO GET DATA TSO16330
SR R3,R3 USE TO HOLD DATA TSO16340
DATCHK IC R3,SDAT(R5) PICK UP CHAR TSO16350
AR R9,R3 ADD TO CHECKSUM TSO16360
LA R5,1(R5) BUMP POINTER TSO16370
BCTR R6,0 TSO16380
LTR R6,R6 MORE DATA? TSO16390
BNZ DATCHK TSO16400
NODAT L R6,LSDAT WILL NEED THIS LATER TSO16410
LR R7,R6 MUNGE WHILE IN R7 TSO16420
BCTR R7,0 SUBTRACT 1 FOR EX FUNCTION TSO16430
EX R7,MOVE MOVE THE DATA TO SNDPKT TSO16440
ST R9,TEMP WE'LL NEED THIS SOON TSO16450
N R9,=X'000000C0' GET MOD 192 TSO16460
M R8,ONE CARRY OVER THE SIGN BIT TSO16470
D R8,O1H GET MOD 64 TSO16480
A R9,TEMP ADD THE TWO VALUES TSO16490
N R9,=X'0000003F' GET MOD 64 OF CHECKSUM TSO16500
A R9,SPACE ADD OFFSET TSO16510
STC R9,PDATA(R6) ADD CHECKSUM AFTER DATA TSO16520
LA R6,1(R6) MOVE POINTER TSO16530
IC R9,SEOL ADD SEND END OF PACKET CHAR TSO16540
STC R9,PDATA(R6) TSO16550
LA R6,5(R6) VALUE OF LSDAT+5 TSO16560
TR SNDPKT(130),ATOE SEND IN EBCDIC TSO16570
TM DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN IS IT OPEN? TSO16580
BZ SPNODEB TSO16590
MVC WRKBUFF(2),=H'20' TSO16600
XC WRKBUFF+2(2),WRKBUFF+2 TSO16610
MVC WRKBUFF+4(16),=CL16'TPUT SEND PACKET' TSO16620
PUT DEBUG,WRKBUFF TSO16630
LA R1,4(,R6) ADJUST LENGTH TSO16640
STH R1,WRKBUFF SET RDW TSO16650
EX R6,DBGMVC1 MOVE IN DATA TSO16660
PUT DEBUG,WRKBUFF TSO16670
SPNODEB TPUT SNDPKT,(R6),CONTROL TSO16680
LTR R15,R15 WAS THERE ANY ERROR? TSO16690
BZ SPRET NO, THEN JUST RETURN TSO16700
MVI ERRNUM,10 SET MICRO DIED TSO16710
MVI STATE,C'A' ABORT ON THIS TSO16720
SPRET L R13,4(R13) TSO16730
L R14,12(R13) TSO16740
LM R0,R12,20(R13) TSO16750
BR 14 TSO16760
SPSAVE DS 18F TSO16770
MOVE MVC PDATA(0),SDAT TSO16780
DBGMVC1 MVC WRKBUFF+4(*-*),SNDPKT TSO16790
LTORG TSO16800
DROP R11 TSO16810
DROP R12 DON'T NEED THEM ANYMORE TSO16820
EJECT TSO16830
********************************************************************** TSO16840
* * TSO16850
* ROUTINE TO PROCESS RECEIVE PACKET REQUEST * TSO16860
* * TSO16870
********************************************************************** TSO16880
RPACK DS 0H TSO16890
STM R14,R12,12(R13) SAVE CALLER'S REGISTERS TSO16900
BALR R12,0 ESTABLISH ADDRESSABILITY TSO16910
USING *,R12 TSO16920
LA R14,RPSAVE ADDRESS OF MY SAVE AREA TSO16930
ST R13,4(R14) SAVE CALLER'S TSO16940
ST R14,8(R13) TSO16950
LR R13,R14 TSO16960
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA TSO16970
L R11,=A(PARMS) TSO16980
USING PARMS,R11 ESTABLISH ADDRESSABILITY TSO16990
TGET RECPKT,130,ASIS TSO17000
LTR R15,R15 WAS THERE AN ERROR? TSO17010
BZ RPTSTDB NO, THEN TEST FOR DEBUG TSO17020
MVI RTYPE,AE SET AN ERROR TSO17030
B RPRET TSO17040
RPTSTDB TM DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN IS IT OPEN? TSO17050
BZ RDNODEB TSO17060
LA R8,4(,R1) SAVE LENGTH TSO17070
MVC WRKBUFF(2),=H'19' TSO17080
XC WRKBUFF+2(2),WRKBUFF+2 TSO17090
MVC WRKBUFF+4(15),=CL15'TGET REC PACKET' TSO17100
PUT DEBUG,WRKBUFF TSO17110
STH R8,WRKBUFF SET RDW TSO17120
EX R8,DBGMVC2 MOVE IN DATA TSO17130
PUT DEBUG,WRKBUFF TSO17140
RDNODEB TR RECPKT(130),ETOA TSO17150
NI FLAGS,X'FF'-FLG4 ASSUME MICRO'LL NAK-NOT RPACK TSO17160
SR R8,R8 INDEX REG FOR RECPKT TSO17170
SR R5,R5 CHECKSUM REGISTER TSO17180
TRY LA R7,RECPKT(R8) ADDRESS OF CHARACTER TSO17190
CLC RSOH,0(R7) IS IT START OF HEADER TSO17200
BE READIN YES; SO FAR, SO GOOD TSO17210
LA R8,1(R8) TRY NEXT CHARACTER TSO17220
C R8,=F'130' SEE IF EXCEED BUFFER TSO17230
BL TRY TSO17240
MVI ERRNUM,X'03' NO "SOH" ERROR TSO17250
B BADP TSO17260
READIN SR R9,R9 ZERO OUT INDEX REG FOR RDAT TSO17270
LA R8,1(R8) INCREMENT COUNTER TSO17280
LA R7,RECPKT(R8) PICK UP LOC OF CHAR COUNT TSO17290
CLC RSOH,0(R7) IS IT START OF HEADER? TSO17300
BE READIN START OVER TSO17310
CLC 0(1,R7),DQUOTE COUNT+' '+3 AND ^d35 TSO17320
BNL CONT CONTINUE IF >= TSO17330
MVI ERRNUM,X'04' BAD LENGTH ATTRIBUTE TSO17340
B BADP TSO17350
CONT IC R5,0(R7) START CHECKSUM TSO17360
LR R7,R5 MUNGE IN R7 TO GET LRDAT TSO17370
S R7,=F'35' LENGTH OF DATA TSO17380
STC R7,LRDAT+3 TSO17390
LA R8,1(R8) INCREMENT TSO17400
SR R7,R7 ZERO IT OUT TSO17410
IC R7,RECPKT(R8) PICK UP PACKET NUMBER TSO17420
CLM R7,B'0001',RSOH IS IT START OF HEADER TSO17430
BE READIN TSO17440
AR R5,R7 ADD TO CHECKSUM TSO17450
S R7,SPACE SUBTRACT THE ' ' TSO17460
STC R7,NUM+3 NUM := RECEIVED PACKET NO. TSO17470
LA R8,1(R8) INCREMENT COUNTER TSO17480
IC R7,RECPKT(R8) PICK UP MESSAGE TYPE TSO17490
CLM R7,B'0001',RSOH IS IT START OF HEADER? TSO17500
BE READIN TSO17510
AR R5,R7 ADD TO CHECKSUM TSO17520
STC R7,RTYPE PUT INTO RTYPE TSO17530
LA R8,1(R8) GO TO NEXT BYTE TSO17540
L R4,LRDAT COUNTER TO GET ALL DATA TSO17550
LUP C R4,ZERO SEE IF PICKED UP ALL DATA TSO17560
BE FIN TSO17570
XC TEMP,TEMP ZERO IT OUT TSO17580
LA R7,RECPKT(R8) NEXT LOCATION IN BUFFER TSO17590
MVC TEMP+3(1),0(R7) PICK UP NEXT BYTE TSO17600
CLC RSOH,TEMP+3 IS IT START OF HEADER TSO17610
BE READIN TSO17620
LA R7,RDAT(R9) WHERE THE DATA'S GOING TSO17630
MVC 0(1,R7),TEMP+3 AND MOVE IT TSO17640
A R5,TEMP ADD TO CHECKSUM TSO17650
LA R8,1(R8) ADD ONE TSO17660
LA R9,1(R9) ADD ONE TSO17670
BCTR R4,0 DECREMENT COUNTER TSO17680
B LUP TSO17690
FIN SR R7,R7 ZERO OUT REGISTER TSO17700
IC R7,RECPKT(R8) GET CHECKSUM TSO17710
CLM R7,B'0001',RSOH IS IT START OF HEADER TSO17720
BE READIN TSO17730
ST R5,TEMP WE'LL NEED THIS SOON TSO17740
N R5,=X'000000C0' GET MOD 192 TSO17750
M R4,ONE CARRY OVER THE SIGN BIT TSO17760
D R4,O1H GET MOD 64 TSO17770
A R5,TEMP ADD THE TWO VALUES TSO17780
N R5,=X'0000003F' GET MOD 64 TSO17790
A R5,SPACE ADD OFFSET TSO17800
CR R5,R7 COMPUTED VS RECEIVED CHECKSUM TSO17810
BE RPRET TSO17820
TM DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN TSO17830
BZ NODEBG2 TSO17840
MVC WRKBUFF(2),=H'18' TSO17850
XC WRKBUFF+2(2),WRKBUFF+2 TSO17860
MVC WRKBUFF+4(14),=CL14'CHECKSUM ERROR' TSO17870
PUT DEBUG,WRKBUFF TSO17880
NODEBG2 MVI ERRNUM,X'05' BAD CHECKSUM ERROR TSO17890
BADP MVI RTYPE,AN RETURN A NAK TSO17900
OI FLAGS,FLG4 RPACK NAK'ED THE PACKET TSO17910
RPRET L R13,4(R13) TSO17920
L R14,12(R13) TSO17930
LM R0,R12,20(R13) TSO17940
BR 14 TSO17950
DBGMVC2 MVC WRKBUFF+4(*-*),RECPKT TSO17960
RPSAVE DS 18F TSO17970
LTORG TSO17980
DROP R11 TSO17990
DROP R12 DON'T NEED THEM ANYMORE TSO18000
EJECT TSO18010
********************************************************************** TSO18020
* * TSO18030
* DISK FILE READ ROUTE WITH DEBUGGING CODE * TSO18040
* * TSO18050
********************************************************************** TSO18060
READX DS 0H TSO18070
USING PARMS,R11 ESTABLISH ADDRESSABILITY TSO18080
STM R12,R15,READSAVE TSO18090
BALR R12,0 TSO18100
USING *,R12 TSO18110
TM KERIN+(DCBRECFM-IHADCB),DCBRECV VARIABLE? TSO18120
BO RDVAR TSO18130
GET KERIN,BUF TSO18140
B RDTSTDB TSO18150
RDVAR GET KERIN,BUF-4 TSO18160
RDTSTDB TM DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN IS IT OPEN? TSO18170
BZ RDNODBG TSO18180
MVC WRKBUFF(2),=H'12' TSO18190
XC WRKBUFF+2(2),WRKBUFF+2 TSO18200
MVC WRKBUFF+4(8),=CL8'QSAM GET' TSO18210
PUT DEBUG,WRKBUFF TSO18220
LH R1,KERIN+(DCBLRECL-IHADCB) TSO18230
STH R1,WRKBUFF TSO18240
EX R1,DBGMVC3 TSO18250
PUT DEBUG,WRKBUFF TSO18260
RDNODBG XR R1,R1 SET RETURN CODE TSO18270
LH R0,KERIN+(DCBLRECL-IHADCB) GET RECORD LENGTH TSO18280
TM KERIN+(DCBRECFM-IHADCB),DCBRECV VARIABLE? TSO18290
BZ *+12 NO, THEN SKIP TSO18300
LH R0,BUF-4 GET LENGTH FROM RDW TSO18310
SH R0,=H'4' REMOVE RDW LENGTH TSO18320
LM R12,R15,READSAVE TSO18330
BR R15 TSO18340
DBGMVC3 MVC WRKBUFF+4(*-*),KERIN TSO18350
* TSO18360
INEOF DS 0H TSO18370
LA R1,12 TSO18380
XR R0,R0 TSO18390
LM R12,R15,READSAVE TSO18400
BR R15 TSO18410
LTORG TSO18420
DROP R11 TSO18430
DROP R12 TSO18440
EJECT TSO18450
********************************************************************** TSO18460
* * TSO18470
* ROUTINE TO PROCESS RECEIVE COMMAND * TSO18480
* * TSO18490
********************************************************************** TSO18500
RECEIVE DS 0H TSO18510
STM R14,R12,12(R13) SAVE CALLER'S REGISTERS TSO18520
BALR R12,0 ESTABLISH ADDRESSABILITY TSO18530
USING *,R12 TSO18540
LA R14,RECSAVE ADDRESS OF MY SAVE AREA TSO18550
ST R13,4(R14) SAVE CALLER'S TSO18560
ST R14,8(R13) TSO18570
LR R13,R14 TSO18580
* USE R11 AS BASE REGISTER FOR THE GLOBAL DATA AREA, 'PARMS' TSO18590
L R11,=A(PARMS) TSO18600
USING PARMS,R11 TSO18610
SR R6,R6 GET ZERO TSO18620
ST R6,NUMTRY ZERO THIS OUT TSO18630
ST R6,N HERE TOO TSO18640
MVI STATE,C'R' SET TO RECEIVE STATE TSO18650
********************************************************************** TSO18660
* MAIN RECEIVE PROCESSING LOOP * TSO18670
********************************************************************** TSO18680
RLOOP CLI STATE,C'D' RECEIVE DATA STATE TSO18690
BE RDATA TSO18700
CLI STATE,C'F' RECEIVE FILE STATE TSO18710
BE RFILE TSO18720
CLI STATE,C'R' RECEIVE INIT STATE TSO18730
BE RINIT TSO18740
CLI STATE,C'C' COMPLETE STATE TSO18750
BE RCOMP TSO18760
CLI STATE,C'A' ABORT STATE TSO18770
BE RABORT TSO18780
MVI ERRNUM,X'02' UNRECOGNIZED STATE TSO18790
B RABORT ELSE, DIE TSO18800
********************************************************************** TSO18810
* PROCESS INITIALIZATION PACKET * TSO18820
********************************************************************** TSO18830
RINIT CLC NUMTRY,IMXTRY SEE IF CAN RECEIVE TSO18840
BL ROK1 YES, WE CAN TSO18850
MVI STATE,C'A' NOPE, GO INTO ABORT STATE TSO18860
B RLOOP TSO18870
ROK1 L R3,NUMTRY TSO18880
LA R3,1(R3) INCREMENT TRIAL COUNTER TSO18890
ST R3,NUMTRY TSO18900
L R4,DSSIZ DEFAULT SEND PACKET SIZE TSO18910
S R4,FIVE USE DEFAULT TO SET "SIZE" TSO18920
ST R4,SIZE IN CASE WE DIE BEFORE IT'S SET TSO18930
L R15,=A(RPACK) GET INIT INFORMATION TSO18940
BALR R14,R15 TSO18950
CLI RTYPE,AE ERROR PACKET? TSO18960
BNE RY1 ALL OK TSO18970
MVI ERRNUM,X'0A' MICRO DIED TSO18980
MVI STATE,C'A' SO WE DO TOO TSO18990
B RLOOP TSO19000
RY1 CLI RTYPE,AS IS IT A SEND-INIT PACKET TSO19010
BNE RN1 MAYBE IT GOT CLOBBERED TSO19020
SR R4,R4 ZERO OUT REGISTER TSO19030
IC R4,RDAT GET FIRST CHARACTER TSO19040
S R4,SPACE SUBTRACT THE ' ' TSO19050
C R4,=F'26' MIN SPACK SIZE TSO19060
BNL RCH1 SO FAR, SO GOOD TSO19070
MVI STATE,C'A' ELSE, ABORT TSO19080
MVI ERRNUM,X'00' INVALID DATA-PACKET-SIZE ERROR TSO19090
B RLOOP TSO19100
RCH1 C R4,MAXPACK MAX PACKET SIZE TSO19110
BNH RCH2 TSO19120
MVI STATE,C'A' ABORT IF SIZE IS ILLEGAL TSO19130
MVI ERRNUM,X'00' BAD SEND DATA LENGTH TSO19140
B RLOOP TSO19150
RCH2 STC R4,SPSIZ+3 USE THE VALUE AS SEND SIZE TSO19160
S R4,FIVE TSO19170
ST R4,SIZE SET IT TO SPSIZ-5 TSO19180
CLC LRDAT(4),=F'4' USING ALL DEFAULTS ? TSO19190
BNH NOCH YUP TSO19200
LA R5,RDAT POINT TO THE BUFFER TSO19210
SR R7,R7 TSO19220
IC R7,4(R5) SEOL THE MICRO WANTS TSO19230
S R7,SPACE UNCHAR (SUBTRACT ' ') TSO19240
STC R7,SEOL TSO19250
CLC LRDAT(4),FIVE ANY MORE DATA? TSO19260
BNH NOCH JUST USE DEFAULTS TSO19270
MVC RQUO(1),5(R5) SET NEW QUOCHAR VALUE TSO19280
NOCH MVC N(4),NUM SYNCH PACKET NUMBERS TSO19290
MVI STYPE,AY SET MESSAGE TYPE TO ACK TSO19300
MVC LSDAT(4),=F'6' SET LENGTH OF DATA SENDING TSO19310
L R5,SPACE MAKE CHARACTER PRINTABLE TSO19320
A R5,RPSIZ ADD REC PACKET SIZE TSO19330
STC R5,SDAT ADD SIZE INFO TO BUFFER TSO19340
L R5,SPACE TSO19350
A R5,=F'8' 8 FOR TIMEOUT TSO19360
STC R5,SDAT+1 TSO19370
L R5,SPACE SEND ZERO + " " FOR NPAD TSO19380
STC R5,SDAT+2 WE'RE THE SLOW GUYS TSO19390
SR R5,R5 PAD WITH NULLS TSO19400
L R3,O1H TSO19410
XR R5,R3 CTL FUNCTION (XOR WITH 64) TSO19420
STC R5,SDAT+3 DON'T NEED PADCHAR EITHER TSO19430
SR R5,R5 ZERO IT OUT FOR NEXT TWO GUYS TSO19440
IC R5,REOL EOL CHAR I NEED TSO19450
A R5,SPACE MAKE PRINTABLE TSO19460
STC R5,SDAT+4 TSO19470
IC R5,QUOCHAR MY QUOTE CHAR TSO19480
STC R5,SDAT+5 TSO19490
L R15,=A(SPACK) ADDRESS OF SPACK TSO19500
BALR R14,R15 SAVE * AND GO TO SPACK TSO19510
CLI STATE,C'A' TSO19520
BE RABORT TSO19530
MVI STATE,C'F' SET TO RECEIVE FILE STATE TSO19540
MVC OLDTRY(4),NUMTRY SAVE TRIAL COUNTER TSO19550
XC NUMTRY,NUMTRY RESET COUNTER TO ZERO TSO19560
L R3,N TSO19570
LA R3,1(R3) ADD ONE TSO19580
ST R3,N STORE VALUE INCREMENTED BY 1 TSO19590
NC N(4),=X'0000003F' MASK TO GET MOD 64 TSO19600
B RLOOP TSO19610
RN1 CLI RTYPE,AN MAYBE IT'S A NAK TSO19620
BNE RSELSE TSO19630
MVI STYPE,AN SEND A NAK PACKET TSO19640
XC LSDAT,LSDAT NO DATA TSO19650
L R15,=A(SPACK) TSO19660
BALR R14,R15 TSO19670
B RLOOP TSO19680
RSELSE MVI STATE,C'A' ELSE,ABORT TSO19690
MVI ERRNUM,X'07' ILLEGAL PACKET TYPE TSO19700
B RLOOP TSO19710
********************************************************************** TSO19720
* PROCESS FILE PACKET * TSO19730
********************************************************************** TSO19740
RFILE CLC NUMTRY,MAXTRY EXCEEDED NO. OF TRIALS ALLOWED TSO19750
BL ROK2 NOPE, STILL OK TSO19760
MVI STATE,C'A' ABORT IF YES TSO19770
B RLOOP TSO19780
ROK2 L R3,NUMTRY TSO19790
LA R3,1(R3) INCREMENT TRIAL COUNTER TSO19800
ST R3,NUMTRY TSO19810
L R15,=A(RPACK) GET ADDRESS OF RPACK TSO19820
BALR R14,R15 GO THERE AND RETURN WHEN DONE TSO19830
CLI RTYPE,AE ERROR PACKET? TSO19840
BNE RY2 MAYBE AN ACK TSO19850
MVI ERRNUM,X'0A' MICRO DIED TSO19860
MVI STATE,C'A' SO WE DO TOO TSO19870
B RLOOP TSO19880
RY2 CLI RTYPE,AS STILL IN INIT STATE? TSO19890
BNE RNZ TRY FOR AN EOF TSO19900
CLC OLDTRY,MAXTRY CAN WE TRY AGAIN? TSO19910
BL ROLD TSO19920
MVI STATE,C'A' ELSE, ABORT TSO19930
B RLOOP TSO19940
ROLD L R3,OLDTRY TSO19950
LA R3,1(R3) INCREMENT COUNTER TSO19960
ST R3,OLDTRY TSO19970
L R3,N GET PACKET NUMBER SENT TSO19980
BCTR R3,0 SUBTRACT ONE FROM IT TSO19990
C R3,NUM NUM MUST EQUAL N-1 TSO20000
BE RNUM TSO20010
MVI ERRNUM,X'08' PREVIOUS PACKET MISSING TSO20020
B RNAK SEND A NAK TSO20030
RNUM MVI STYPE,AY ACK PACKET TSO20040
ST R3,N MAKE SEND SEQ NO. = N-1 TSO20050
MVC LSDAT(4),=F'6' SET DATA LENGTH VARIABLE TSO20060
L R15,=A(SPACK) TSO20070
BALR R14,R15 GO TO SPACK AND RETURN TSO20080
CLI STATE,C'A' TSO20090
BE RABORT TSO20100
L R4,N TSO20110
LA R4,1(R4) ADD ONE TSO20120
ST R4,N RESTORE N TO PROPER VALUE TSO20130
XC NUMTRY,NUMTRY RESET COUNTER TO ZERO TSO20140
B RLOOP TSO20150
RNZ CLI RTYPE,AZ TSO20160
BNE RNF MAYBE IT'S AN 'F' TSO20170
CLC OLDTRY,MAXTRY CAN WE TRY AGAIN? TSO20180
BL ROLD2 TSO20190
MVI STATE,C'A' ELSE,ABORT TSO20200
B RLOOP TSO20210
ROLD2 L R3,OLDTRY TSO20220
LA R3,1(R3) INCREMENT COUNTER TSO20230
ST R3,OLDTRY TSO20240
L R3,N GET PACKET NUMBER SENT TSO20250
BCTR R3,0 SUBTRACT ONE FROM IT TSO20260
C R3,NUM NUM MUST EQUAL N-1 TSO20270
BE RNUM2 TSO20280
MVI ERRNUM,X'08' PREVIOUS PACKET MISSING TSO20290
B RNAK SEND A NAK TSO20300
RNUM2 MVI STYPE,AY ACK PACKET TSO20310
ST R3,N SEND SEQ := N-1 TSO20320
XC LSDAT,LSDAT NO DATA TSO20330
L R15,=A(SPACK) TSO20340
BALR R14,R15 TSO20350
CLI STATE,C'A' TSO20360
BE RABORT TSO20370
L R4,N TSO20380
LA R4,1(R4) ADD ONE TSO20390
ST R4,N RESTORE N TO PROPER VALUE TSO20400
XC NUMTRY,NUMTRY RESET COUNTER TO ZERO TSO20410
B RLOOP TSO20420
RNF CLI RTYPE,AF TSO20430
BNE RNB WELL, IT'S NOT A FNAME TSO20440
CLC NUM,N THEY HAVE TO BE EQUAL TSO20450
BE RNUM3 TSO20460
MVI ERRNUM,X'08' PREVIOUS PACKET MISSING TSO20470
B RNAK SEND A NAK TSO20480
RNUM3 MVI STYPE,AY ACK PACKET TSO20490
XC LSDAT,LSDAT NO DATA TSO20500
OVER L R15,=A(SPACK) TSO20510
BALR R14,R15 SEND ACK TSO20520
CLI STATE,C'A' TSO20530
BE RABORT TSO20540
MVC OLDTRY(4),NUMTRY KEEP NUMTRY FOR LATER TSO20550
XC NUMTRY,NUMTRY RESET TO ZERO TSO20560
L R3,N TSO20570
LA R3,1(R3) ADD ONE TSO20580
ST R3,N INCREMENT COUNTER TSO20590
NC N(4),=X'0000003F' MASK TO GET MOD 64 TSO20600
MVI STATE,C'D' DATA RECEIVE STATE TSO20610
B RLOOP TSO20620
RNB CLI RTYPE,AB SEE IF IT'S A BREAK TSO20630
BNE RNN MAYBE GOT A NAK TSO20640
CLC NUM,N TSO20650
BE RNUM4 TSO20660
MVI ERRNUM,X'08' PREVIOUS PACKET MISSING TSO20670
B RNAK SEND A NAK TSO20680
RNUM4 MVI STYPE,AY ACK PACKET TSO20690
XC LSDAT,LSDAT NO DATA TSO20700
L R15,=A(SPACK) TSO20710
BALR R14,R15 TSO20720
CLI STATE,C'A' TSO20730
BE RABORT TSO20740
MVI STATE,C'C' COMPLETE STATE TSO20750
B RLOOP TSO20760
RNN CLI RTYPE,AN SEE IF GOT A NAK TSO20770
BNE RNELSE TSO20780
RNAK MVI STYPE,AN SEND A NAK PACKET TSO20790
XC LSDAT,LSDAT NO DATA TSO20800
L R15,=A(SPACK) TSO20810
BALR R14,R15 TSO20820
B RLOOP DO NOTHING ON A NAK TSO20830
RNELSE MVI STATE,C'A' ABORT OTHERWISE TSO20840
MVI ERRNUM,X'07' ILLEGAL PACKET TYPE TSO20850
B RLOOP TSO20860
********************************************************************** TSO20870
* RECEIVE DATA PACKETS * TSO20880
********************************************************************** TSO20890
RDATA CLC NUMTRY,MAXTRY HAVE WE EXCEEDED OUR LIMIT? TSO20900
BL ROK3 TSO20910
MVI STATE,C'A' ELSE, ABORT TSO20920
B RLOOP TSO20930
ROK3 L R4,NUMTRY TSO20940
LA R4,1(R4) INCREMENT TSO20950
ST R4,NUMTRY SAVE INCREMENTED COUNTER TSO20960
L R15,=A(RPACK) TSO20970
BALR R14,R15 CALL RPACK TSO20980
CLI RTYPE,AE ERROR PACKET? TSO20990
BNE RY3 MAYBE AN ACK TSO21000
MVI ERRNUM,X'0A' MICRO DIED TSO21010
MVI STATE,C'A' WE ABORT TOO TSO21020
B RLOOP TSO21030
RY3 CLI RTYPE,AD IS THIS A DATA PACKET? TSO21040
BNE RDF MAYBE IT'S AN FNAME PACKET TSO21050
CLC N,NUM CHECK FOR RIGHT PACKET TSO21060
BNE DIF TSO21070
L R15,=A(PTCHR) TSO21080
BALR R14,R15 PUT CHARACTERS INTO FILE TSO21090
LTR R7,R7 CHECK FOR NO ERROR TSO21100
BZ OKWR NO ERROR TSO21110
MVI STATE,C'A' ABORT ON FILE SYSTEM ERROR TSO21120
B RLOOP TSO21130
OKWR MVI STYPE,AY ACK PACKET TSO21140
XC LSDAT,LSDAT NO DATA TSO21150
L R15,=A(SPACK) TSO21160
BALR R14,R15 TSO21170
CLI STATE,C'A' TSO21180
BE RABORT TSO21190
MVC OLDTRY(4),NUMTRY SAVE NUMTRY'S VALUE IN OLDTRY TSO21200
XC NUMTRY,NUMTRY RESET NUMTRY TSO21210
L R3,N TSO21220
LA R3,1(R3) TSO21230
ST R3,N INCREMENT COUNTER TSO21240
NC N(4),=X'0000003F' MASK TO GET MOD 64 TSO21250
B RLOOP TSO21260
DIF CLC OLDTRY,MAXTRY CAN WE DO IT? TSO21270
BL DIFNUM TSO21280
MVI STATE,C'A' AND ABORT TSO21290
B RLOOP TSO21300
DIFNUM L R4,OLDTRY TSO21310
LA R4,1(R4) TSO21320
ST R4,OLDTRY INCREMENT THIS COUNTER TSO21330
L R4,N TSO21340
BCTR R4,0 TSO21350
C R4,NUM NUM MUST EQUAL N-1 TSO21360
BE DIFOK TSO21370
MVI ERRNUM,X'08' PREVIOUS PACKET MISSING TSO21380
B RDN1 SEND A NAK TSO21390
DIFOK XC NUMTRY,NUMTRY RESET COUNTER TO ZERO TSO21400
MVI STYPE,AY ACK PACKET TSO21410
XC LSDAT,LSDAT NO DATA TSO21420
ST R4,N SET N TO N-1 TO RESEND PACKET TSO21430
L R15,=A(SPACK) TSO21440
BALR R14,R15 SEND THE PACKET TSO21450
CLI STATE,C'A' TSO21460
BE RABORT TSO21470
L R4,N TSO21480
LA R4,1(R4) ADD ONE TSO21490
ST R4,N RESTORE N TO PROPER VALUE TSO21500
B RLOOP AND RETURN TSO21510
RDF CLI RTYPE,AF SENDING FILENAME AGAIN? TSO21520
BNE RDZ TSO21530
CLC OLDTRY,MAXTRY CAN WE DO IT? TSO21540
BL FILOVER TRYING IT AGAIN TSO21550
MVI STATE,C'A' IF NO, ABORT TSO21560
B RLOOP TSO21570
FILOVER L R4,OLDTRY TSO21580
LA R4,1(R4) TSO21590
ST R4,OLDTRY SAVE INCREMENTED VALUE TSO21600
L R4,N TSO21610
BCTR R4,0 NEED VALUE OF N-1 TSO21620
C R4,NUM N-1 MUST EQUAL NUM TSO21630
BE FILOK TSO21640
MVI ERRNUM,X'08' PREVIOUS PACKET MISSING TSO21650
B RDN1 SEND A NAK TSO21660
FILOK XC NUMTRY,NUMTRY RESET TO ZERO TSO21670
XC LSDAT,LSDAT NO DATA TSO21680
MVI STYPE,AY ACK PACKET AGAIN TSO21690
ST R4,N SET N TO N-1 FOR NOW TSO21700
OVRWRT L R15,=A(SPACK) TSO21710
BALR R14,R15 TSO21720
CLI STATE,C'A' TSO21730
BE RABORT TSO21740
L R4,N TSO21750
LA R4,1(R4) ADD ONE TSO21760
ST R4,N RESTORE N TO PROPER VALUE TSO21770
B RLOOP AND RETURN TSO21780
RDZ CLI RTYPE,AZ IS THIS AN EOF PACKET? TSO21790
BNE RDN TSO21800
CLC N,NUM ARE THEY EQUAL TSO21810
BE RDOK TSO21820
MVI ERRNUM,X'08' PREVIOUS PACKET MISSING TSO21830
B RDN1 SEND A NAK TSO21840
RDOK MVI STYPE,AY ACK THE PACKET TSO21850
XC LSDAT,LSDAT NO DATA TSO21860
L R15,=A(SPACK) TSO21870
BALR R14,R15 TSO21880
MVC OLDTRY(4),NUMTRY SAVE NUMTRY'S VALUE HERE TSO21890
XC NUMTRY,NUMTRY AND RESET COUNTER TSO21900
L R3,N TSO21910
LA R3,1(R3) TSO21920
ST R3,N STORE VALUE INCREMENTED BY 1 TSO21930
NC N(4),=X'0000003F' MASK TO GET MOD 64 TSO21940
MVI STATE,C'F' TRY FOR ANOTHER FILE TSO21950
B RLOOP TSO21960
RDN CLI RTYPE,AN DO WE NEED TO SEND A NAK? TSO21970
BNE RDELSE TSO21980
RDN1 MVI STYPE,AN SEND A NAK TSO21990
XC LSDAT,LSDAT NO DATA TSO22000
L R15,=A(SPACK) TSO22010
BALR R14,R15 TSO22020
B RLOOP TSO22030
RDELSE MVI STATE,C'A' UNRECOGNIZED PACKET - ABORT TSO22040
MVI ERRNUM,X'07' ILLEGAL PACKET TYPE TSO22050
B RLOOP TSO22060
SAYNO MVI STYPE,AN SEND A NAK PACKET TSO22070
XC LSDAT,LSDAT NO DATA TSO22080
MVI ERRNUM,X'0B' ILLEGAL FILENAME ERROR TSO22090
L R15,=A(SPACK) TSO22100
BALR R14,R15 TSO22110
B RLOOP TSO22120
********************************************************************** TSO22130
* RECEIVE ABORT PROCESS * TSO22140
********************************************************************** TSO22150
RABORT DS 0H TSO22160
CLI ERRNUM,X'0A' DID THE MICRO DIE? TSO22170
BE RNOERRP NO ERROR PACKET IF SO TSO22180
MVI STYPE,AE ERROR PACKET TSO22190
MVC LSDAT(4),=F'20' ALL MSGS ARE THIS LONG TSO22200
MVC N(4),NUM SYNCH PACKET NUMBERS TSO22210
SR R5,R5 TSO22220
IC R5,ERRNUM TSO22230
M R4,=F'20' OFFSET := ERRNUM * 20 TSO22240
LA R5,ERRTAB(R5) TSO22250
MVC SDAT(20),0(R5) SPACK NEEDS THE DATA HERE TSO22260
TR SDAT(20),ETOA TSO22270
L R15,=A(SPACK) TSO22280
BALR R14,R15 SEND ERROR PACKET & DIE TSO22290
RNOERRP LA R15,4 SET A NON-ZERO RETCODE TSO22300
B RECRET PREPARE TO LEAVE TSO22310
********************************************************************** TSO22320
* RECEIVE COMPLETE PROCESS * TSO22330
********************************************************************** TSO22340
RCOMP SR R15,R15 RETCODE OF ZERO TSO22350
RECRET L R13,4(R13) TSO22360
L R14,12(R13) TSO22370
LM R0,R12,20(R13) TSO22380
BR 14 TSO22390
EJECT TSO22400
********************************************************************** TSO22410
* * TSO22420
* ROUTINE TO PUT A CHARACTER IN OUTPUT BUFFER AND DUMP WHEN FULL * TSO22430
* * TSO22440
********************************************************************** TSO22450
PTCHR SR R4,R4 USE TO HOLD QUOCHAR TSO22460
SR R6,R6 USE TO HOLD LRECL TSO22470
SR R8,R8 COUNTER WITHIN RDAT TSO22480
L R9,RSAVPL COUNTER WITHIN RBUF TSO22490
IC R4,RQUO TSO22500
IC R6,LRECL TSO22510
L R5,LRDAT COUNTER TO GET ALL DATA TSO22520
RLUP SR R7,R7 USE TO PICK UP CHAR TSO22530
LTR R5,R5 MORE DATA LEFT? TSO22540
BNZ MOR LEAVE IF ALL DONE TSO22550
CLI PREV,X'4D' ARE WE IN MIDDLE OF LINE? TSO22560
BER R14 LEAVE IF NOT TSO22570
ST R9,RSAVPL SAVE OUR PLACE TSO22580
SR R7,R7 ZERO RETCODE TSO22590
BR R14 TSO22600
MOR BCTR R5,0 DECREMENT CHAR COUNTER TSO22610
IC R7,RDAT(R8) GET DATA FROM RDAT TSO22620
CR R7,R4 IS IT THE QUOTE CHARACTER? TSO22630
BNE REGULAR TSO22640
BCTR R5,0 DECREMENT CHAR COUNT TSO22650
LA R8,1(R8) MOVE POINTER TSO22660
IC R7,RDAT(R8) PICK UP SPECIAL CHAR TSO22670
C R7,=X'0000004D' IS IT A CR? (CHAR(CR)) TSO22680
BNE NOCR WRITE OUT RECORD IF YES TSO22690
MVI PREV,X'4D' JUST HAD A CR TSO22700
LA R8,1(R8) IGNORE CONTROL CHAR TSO22710
B RFIN TSO22720
NOCR C R7,=X'0000004A' HOW ABOUT A LF? (CHAR(LF)) TSO22730
BNE NOLF IF YES, WRITE OUT RECORD TSO22740
LA R8,1(R8) IGNORE CONTROL CHAR TSO22750
CLI PREV,X'4D' WAS LAST THING CR? TSO22760
BNE RFIN NOPE, THEN KEEP ON TSO22770
B RLUP IGNORE LF IF PREV=CR TSO22780
NOLF CR R7,R4 IS IT THE QUOCHAR TSO22790
BE REGULAR DON'T CONVERT IF IT IS TSO22800
A R7,O1H ADD ^O100 TSO22810
N R7,=X'0000007F' GET MOD ^O200 TSO22820
REGULAR STC R7,RBUF(R9) STORE CHAR IN RBUF TSO22830
LA R9,1(R9) MOVE RBUF COUNTER TSO22840
LA R8,1(R8) MOVE RDAT COUNTER TSO22850
MVI PREV,X'00' BLANK OUT CR IF WAS THERE TSO22860
C R9,=F'255' ONLY 256 CHARS ALLOWED TSO22870
BNH RLUP AND CONTINUE TSO22880
LR R10,R9 USE MAX LENGTH OF 256 TSO22890
B WRFIL AND WRITE TO FILE TSO22900
RFIN LTR R10,R9 GET DATA SIZE TSO22910
BZ FUDGE GOTTA FAKE A BLANK LINE TSO22920
C R7,=X'0000004D' IS IT A CR? (CHAR(CR)) TSO22930
BE WRFIL TSO22940
C R7,=X'0000004A' HOW ABOUT A LF? (CHAR(LF)) TSO22950
BE WRFIL TSO22960
ST R10,RSAVPL SAVE DATA RECEIVED SO FAR TSO22970
SR R7,R7 ZERO RETCODE TSO22980
BR 14 TSO22990
FUDGE MVI RBUF,X'20' MAKE FIRST CHAR A SPACE TSO23000
LA R10,1(R10) LENGTH OF ONE TSO23010
WRFIL XC RSAVPL,RSAVPL RESET THE POINTER TSO23020
TR RBUF(256),ATOE MAKE EBCDIC AGAIN TSO23030
CLI RFM,C'V' IS IT VARIABLE FORMAT? TSO23040
BE VAR TSO23050
CR R10,R6 TSO23060
BH PUR IGNORE DATA AFTER LRECL VALUE TSO23070
CR R10,R6 PAD OUT TO LRECL SIZE ? TSO23080
BE VAR NOPE, IT'S OK. TSO23090
LR R2,R6 GET LRECL SIZE TSO23100
SR R2,R10 PAD WITH THIS MANY SPACES TSO23110
BCTR R2,0 MINUS ONE FOR THE 'EX' TSO23120
LA R9,RBUF(R10) START PADDING HERE TSO23130
MVI 0(R9),C' ' PUT IN THE FIRST SPACE TSO23140
LTR R2,R2 TSO23150
BZ PUR DON'T PAD IF SIZE DIF WAS ONE TSO23160
BCTR R2,0 SUBRTRACT SPACE WE JUST ADDED TSO23170
EX R2,PAD PAD OUT BUFFER TSO23180
PUR LR R10,R6 LENGTH HAS TO BE THIS SIZE TSO23190
VAR DS 0H RJR TSO23200
LA R15,WRITEX TSO23210
BALR R15,R15 TSO23220
SR R9,R9 START AT BEGINNING OF RBUF TSO23230
B RLUP GET NEXT LINE IF OK TSO23240
RECSAVE DS 18F TSO23250
PAD MVC 1(0,R9),0(R9) PAD OUT WITH SPACES TSO23260
LTORG TSO23270
* TSO23280
EJECT TSO23290
********************************************************************** TSO23300
* * TSO23310
* DISK FILE WRITE ROUTE WITH DEBUGGING CODE * TSO23320
* * TSO23330
********************************************************************** TSO23340
WRITEX DS 0H TSO23350
USING PARMS,R11 TSO23360
STM R12,R15,WRITSAVE TSO23370
BALR R12,0 TSO23380
USING *,R12 TSO23390
LA R0,RBUF POINT TO RBUF TSO23400
TM KEROUT+(DCBRECFM-IHADCB),DCBRECV VARIABLE? TSO23410
BZ WRITEX2 NO, THEN DON'T ADJUST TSO23420
LA R0,RBUF-4 POINT TO RDW TSO23430
LR R15,R10 GET THE LENGTH TSO23440
AH R15,=H'4' INCLUDE LENGTH OF RDW TSO23450
SR R1,R1 TSO23460
STH R1,RBUF-2 CLEAR RDW TSO23470
IC R1,LRECL GET LRECL TSO23480
CR R15,R1 IS THE RECORD GT MAX LRECL? TSO23490
BNH *+6 NO, THEN IT'S OK TSO23500
LR R15,R1 ELSE SET TO MAX TSO23510
STH R15,RBUF-4 TSO23520
WRITEX2 DS 0H TSO23530
PUT KEROUT,(R0) TSO23540
TM DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN IS IT OPEN? TSO23550
BZ WRNODBG TSO23560
MVC WRKBUFF(2),=H'12' TSO23570
XC WRKBUFF+2(2),WRKBUFF+2 TSO23580
MVC WRKBUFF+4(8),=CL8'QSAM PUT' TSO23590
PUT DEBUG,WRKBUFF TSO23600
EX R10,DBGMVC4 TSO23610
LA R1,4(,R10) TSO23620
STH R1,WRKBUFF TSO23630
PUT DEBUG,WRKBUFF TSO23640
WRNODBG LM R12,R15,WRITSAVE TSO23650
BR R15 TSO23660
DBGMVC4 MVC WRKBUFF+4(*-*),RBUF TSO23670
DROP R11 TSO23680
DROP R12 TSO23690
LTORG TSO23700
EJECT TSO23710
********************************************************************** TSO23720
* * TSO23730
* ROUTINE TO PARSE COMMANDS AND CREATE PARSE TABLE * TSO23740
* * TSO23750
********************************************************************** TSO23760
PARSER STM R14,R12,12(R13) SAVE REGISTERS TSO23770
LR R12,R15 MOVE THE BASE REGISTER TSO23780
USING PARSER,R12 ## TSO23790
L R11,=A(PARMS) GET ADDRESS OF WORKAREAS TSO23800
USING PARMS,R11 TSO23810
LR R3,R0 R3 = TEXT LENGTH TSO23820
BCTR R1,0 R1 ==> BYTE BEFORE PARM TSO23830
LA R3,0(R1,R3) R3 ==> END OF LINE TSO23840
LA R2,1 R2 = PARSING INCREMENT TSO23850
LA R5,PTRTBL R5 ==> TARGET AREA TSO23860
LA R6,4 R6 = POINTER INCREMENT TSO23870
STM R5,R6,PARSELST SAVE FOR PARSING TSO23880
LA R7,PTRTBL+PTRTBLL-4 R7 ==> END OF TARGET TSO23890
* TSO23900
SCNTOKEN BXH R1,R2,SCNFINIS SCAN FOR PARM START TSO23910
CLI 0(R1),C' ' FOUND A BLANK? TSO23920
BE SCNTOKEN YES, THEN KEEP LOOKING TSO23930
ST R1,0(,R5) SAVE PTR TO OPERAND TSO23940
BXH R5,R6,SCNFINIS BR ON END OF TARGET AREA TSO23950
SCNLASTC BXH R1,R2,SCNFINIS SCAN TO END OF OPERAND TSO23960
CLI 0(R1),C' ' IS THIS BLANK AT END OF OPERAND TSO23970
BNE SCNLASTC IF SO, MOVE TOKEN TSO23980
LR R9,R1 REMEMBER JUST AFTER OPERAND TSO23990
B SCNTOKEN FIND START OF NEXT OPERAND TSO24000
SCNFINIS MVI 0(R9),C' ' MARK THE END OF OPERANDS TSO24010
ST R9,0(R5) SAVE POINTER TO END TSO24020
ST R5,PARSELST+8 SAVE END TARGET TSO24030
LM R14,R12,12(R13) RESTORE THE REGISTERS TSO24040
BR R14 RETURN TO CALLER TSO24050
LTORG TSO24060
DROP R11 TSO24070
DROP R12 DON'T NEED THEM ANYMORE TSO24080
EJECT TSO24090
PARMS DS 0H GLOBAL DATA LIST TSO24100
USING PARMS,R11 TSO24110
SNDPKT DS CL130 SEND THIS TO MICRO TSO24120
ORG SNDPKT TSO24130
PHDR DS X TSO24140
PLEN DS X TSO24150
PNUM DS X TSO24160
PTYPE DS X TSO24170
PDATA DS 0C TSO24180
ORG , TSO24190
RECPKT DS CL130 RECEIVE THIS FROM MICRO TSO24200
LSDAT DS F SEND PACKET SIZE TSO24210
LRDAT DS F RECEIVE PACKET SIZE TSO24220
FLAGS DC X'00' USE TO TEST OUR FLAGS TSO24230
NAME DC 18X'20' NAME OF FILE(S) TO SEND TSO24240
DS 0F TSO24250
DS 0F TSO24260
INPUT DS CL130 INPUT BUFFER TSO24270
DS 0F TSO24280
DS F RDW FOR VARIABLE RECORDS TSO24290
BUF DS CL260 DISK READ INTO HERE TSO24300
DS F RDW FOR VARIABLE RECORDS TSO24310
RBUF DS CL260 DISK WRITE FROM HERE TSO24320
N DC F'0' SEND PACKET NUMBER TSO24330
NUM DC F'0' RECEIVE PACKET NUMBER TSO24340
NUMTRY DC F'0' TRIAL COUNTER FOR TRANSFERS TSO24350
OLDTRY DS F COUNTER FOR PREVIOUS PACKET TSO24360
STORLOC DS F POINTER TO EXTRA STORAGE TSO24370
MAXPACK DC F'94' MAX PACKET SIZE TSO24380
RECL DS F RECORD LEN (IF RECFM = V) TSO24390
RPSIZ DC F'94' MAX RECEIVE PACKET SIZE TSO24400
DSSIZ DC F'40' DEFAULT MAX SEND PACKET SIZE TSO24410
SPSIZ DS F SEND PACKET SIZE TSO24420
MAXTRY DC F'5' NO. OF TIMES TO RETRY PACKET TSO24430
IMXTRY DC F'16' NO. OF INITIAL TRIALS ALLOWED TSO24440
SIZE DS F MAX SIZE FOR SEND DATA TSO24450
DEL DC F'127' OCTAL 177 (DELETE CHAR) TSO24460
ZERO DC F'0' TSO24470
ONE DC F'1' TSO24480
FIVE DC F'5' TSO24490
TWO DC F'2' TSO24500
SPACE DC F'32' ASCII SPACE TSO24510
O1H DC F'64' OCTAL 100 TSO24520
O2H DC F'128' OCTAL 200 TSO24530
SAVPL DC F'0' POINTER WITHIN BUF,INIT=0 TSO24540
RSAVPL DC F'0' POINTER IN 'PTCHR',INIT=0 TSO24550
DQUOTE DC X'23' DEFAULT QUOTE CHARACTER = # TSO24560
QUOCHAR DS X QOUTE CHAR WE'LL SEND TSO24570
RQUO DS X MICRO'S QUOTE CHAR TSO24580
TEMP DS F TEMPORARY SPACE TSO24590
DS 0D TSO24600
PKVAR DS D USE FOR PICKING UP INTEGER TSO24610
SDAT DS CL130 TEMP PLACE FOR SEND DATA TSO24620
RDAT DS CL130 TEMP PLACE FOR RECEIVE DATA TSO24630
FILNAML DS H LENGTH OF FILENAME TSO24640
FILNAM DS CL18 SEND/REC FILENAME TSO24650
STATE DS C OUR CURRENT STATE TSO24660
DEOL DC X'0D' DEFAULT END OF PACKET (CR) TSO24670
REOL DS X EOL CHAR I NEED (CR) TSO24680
SEOL DS X EOL I'LL SEND TSO24690
DSOH DC X'01' DEFAULT START OF HEADER (CTL A) TSO24700
RSOH DS X RECEIVE START OF HEADER TSO24710
SSOH DS X SEND START OF HEADER TSO24720
DLRECL DC X'50' DEFAULT LRECL SIZE OF 80 TSO24730
LRECL DS X LRECL PROGRAM WILL USE TSO24740
DBLKSIZE DC H'80' DEFAULT BLKSIZE OF 80 TSO24750
BLKSIZE DS H BLKSIZE PROGRAM WILL USE TSO24760
DTRACK DC F'5' DEFAULT SPACE ALLOCATION TSO24770
DRECFM DC C'F' DEFAULT WITH FIXED RECFM TSO24780
RFM DS C RECFM PROGRAM WILL USE TSO24790
PREV DS C PREVIOUS CHAR REC (IN PTCHR) TSO24800
BLIP DS X SAVE USER'S BLIP CHAR TSO24810
LINSIZ DS F SAVE USER'S CONSOLE LINESIZE TSO24820
ERRNUM DS X ERROR NUMBER,IN CASE WE DIE TSO24830
OLDERR DS X ERROR OF PREVIOUS EXECUTION TSO24840
STYPE DS C TYPE OF PACKET SENT TSO24850
RTYPE DS C TYPE OF PACKET RECEIVED TSO24860
* TSO24870
READSAVE DS 4F TSO24880
WRITSAVE DS 4F TSO24890
PARSELST DS 3F PTRS TO OPERAND STACK TSO24900
PTRTBL DS 15F OPERAND STACK TSO24910
PTRTBLL EQU *-PTRTBL LENGTH OF PTRTBL TSO24920
DBLWRK DS D TSO24930
IDSYS DC F'2' MVS TSO TSO24940
DDNAME DC CL8' ' DDNAME TO ALLOCATE TSO24950
DSNAME DC CL80' ' DSNAME TO ALLOCATE TSO24960
DSNAMEX DC CL80' ' WRKBUFFER TSO24970
MEMBER DC CL8' ' MEMBER NAME FOR PDS ALLOC TSO24980
CMSXXX DC CL8' ' USED IN CMS ONLY TSO24990
CMSYYY DC CL8' ' TSO25000
CMSZZZ DC CL2' ' TSO25010
DISP1 DC F'2' DISP (0=NEW,1=OLD,2=SHR) TSO25020
DISP2 DC F'3' DISP (0=UNCAT,1=CAT,3=KEEP) TSO25030
INOUT DC F'2' 0=INPUT,1=OUTPUT,2=INOUT) TSO25040
RECFMX DC F'1' 1=FB,2=VBS TSO25050
BLKSIZEX DC F'3600' FOR NEW DATA SETS ONLY TSO25060
LRECLX DC F'80' .... TSO25070
DEV DC CL8'SYSDA' DEVICE TSO25080
TRACK DC F'20' # TRACKS TO ALLOC FOR NEW DSETS TSO25090
DYNALCRC DC F'0' RETURN CODE FROM FUNCTION TSO25100
WRKBUFF DS CL280 TSO25110
PREFIX DC CL8' ' USERS DSET PREFIX FROM UPT TSO25120
PREFIXL DC F'0' PREFIX LENGTH-1 TSO25130
DDELAY DC F'2000' DEFAULT DELAY TIME TSO25140
DELAY DS F DELAY TIME TSO25150
* TSO25160
* THIS IS THE DYNALC PARM LIST USED FOR BOTH ALLOCATION AND TSO25170
* CREATION OF DATA SETS. TSO25180
* TSO25190
DYNAPARM DS 0F TSO25200
DC A(IDSYS,DDNAME,DSNAME,MEMBER,CMSXXX,CMSYYY,CMSZZZ,DISP1,DISP2) TSO25210
DC A(INOUT,RECFMX,BLKSIZEX,LRECLX,DEV,TRACK) TSO25220
DC X'80',AL3(DYNALCRC) TSO25230
* TSO25240
* TABLE TO TRANSLATE TO UPPER CASE TSO25250
* TSO25260
UPPER DC 256AL1(*-UPPER) TSO25270
ORG UPPER+X'81' TSO25280
DC C'ABCDEFGHI' TSO25290
ORG UPPER+X'91' TSO25300
DC C'JKLMNOPQR' TSO25310
ORG UPPER+X'A2' TSO25320
DC C'STUVWXYZ' TSO25330
ORG TSO25340
* THIS IS THE ASCII TO EBCDIC TABLE TSO25350
ATOE DC X'00010203372D2E2F1605250B0C0D0E0F' TSO25360
DC X'101112133C3D322618193F271C1D1E1F' TSO25370
DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' TSO25380
DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' TSO25390
DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' TSO25400
DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D' TSO25410
DC X'79818283848586878889919293949596' TSO25420
DC X'979899A2A3A4A5A6A7A8A9C04FD0A107' TSO25430
*THIS IS THE EBCDIC TO ASCII CONVERSION TABLE TSO25440
*CHARACTERS NOT REPRESENTABLE IN ASCII ARE REPLACED BY A NULL TSO25450
ETOA DC X'000102030009007F0000000B0C0D0E0F' TSO25460
*G DC X'1011121300000800181900001C1D1E1F' TSO25470
DC X'10111213000D0800181900001C1D1E1F' TSO25480
DC X'00000000000A171B0000000000050607' TSO25490
DC X'0000160000000004000000001415001A' TSO25500
DC X'20000000000000000000002E3C282B7C' TSO25510
DC X'2600000000000000000021242A293B5E' TSO25520
DC X'2D2F00000000000000007C2C255F3E3F' TSO25530
DC X'000000000000000000603A2340273D22' TSO25540
DC X'00616263646566676869007B00000000' TSO25550
DC X'006A6B6C6D6E6F707172007D00000000' TSO25560
DC X'007E737475767778797A0000005B0000' TSO25570
DC X'000000000000000000000000005D0000' TSO25580
DC X'7B414243444546474849000000000000' TSO25590
DC X'7D4A4B4C4D4E4F505152000000000000' TSO25600
DC X'5C00535455565758595A000000000000' TSO25610
DC X'303132333435363738397C0000000000' TSO25620
* TSO25630
* TABLE OF ERROR MESSAGES (IN CASE WE ABORT) TSO25640
ERRTAB DC CL20'Bad send-packet size' ERR MSG #0 TSO25650
DC CL20'Bad message number' ERR MSG #1 TSO25660
DC CL20'Unrecognized state' ERR MSG #2 TSO25670
DC CL20'No SOH encountered' ERR MSG #3 TSO25680
DC CL20'Bad character count' ERR MSG #4 TSO25690
DC CL20'Bad checksum' ERR MSG #5 TSO25700
DC CL20'Disk is full' ERR MSG #6 TSO25710
DC CL20'Illegal packet type' ERR MSG #7 TSO25720
DC CL20'Lost a packet' ERR MSG #8 TSO25730
DC CL20'Micro sent a NAK' ERR MSG #9 TSO25740
DC CL20'Micro aborted' ERR MSG #10 TSO25750
DC CL20'Illegal file name' ERR MSG #11 TSO25760
DC CL20'Invalid lrecl' ERR MSG #12 TSO25770
DC CL20'Permanent I/O error' ERR MSG #13 TSO25780
DC CL20'Disk is read-only' ERR MSG #14 TSO25790
DC CL20'Recfm conflict' ERR MSG #15 TSO25800
DC CL20'Err allocating space' ERR MSG #16 TSO25810
DATASET CAMLST NAME,DSNAME,,WRKBUFF TSO25820
KERIN DCB DDNAME=KERIN,DSORG=PS,MACRF=(GM), XTSO25830
EODAD=INEOF TSO25840
KEROUT DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=84, XTSO25850
RECFM=VB TSO25860
DEBUG DCB DDNAME=DEBUG,DSORG=PS,MACRF=(PM),LRECL=260,BLKSIZE=2048, XTSO25870
RECFM=VB TSO25880
MODDCBF DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=80, XTSO25890
RECFM=FB TSO25900
MODDCBFL EQU *-MODDCBF TSO25910
MODDCBV DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=84, XTSO25920
RECFM=VB TSO25930
MODDCBVL EQU *-MODDCBV TSO25940
END KERMIT TSO25950