Columbia Kermit

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

/ Columbia Kermit / kermit.zip / ibmtsochicago / tsos1.asm < prev next >

Wrap

Assembly Source File | 2020-01-01 | 237KB | 2,930 lines

*****************************< START OF ETOA >**************************TSO25240 * 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 *****************************< START OF KERMIT >************************TSO25240 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 * -------------------------------------------------------------------- TSO00680 * This version has support for YALE ASCII Terminal TSO00680 * Communications System V2.1 TSO00680 * TSO00680 * Added by Charles Painter TSO00680 * University of Toronto Computing Services TSO00680 * University of Toronto, Ontario, Canada TSO00680 * December 1984. TSO00680 * -------------------------------------------------------------------- TSO00680 * 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 CRP TSO01630 * LTR R0,R0 IS THIS A GRAPHICS DEVICE? CRP TSO01640 * BNZ BADDEV YES, THEN REFUSE USER CRP 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 CRP 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 CRP TSO16680 SPNODEB DS 0H CRP LA R1,TPCNPRM GET ADDRESS OF PARM LIST CRP LA R15,S1LAST GET LAST TPUT FLAG CRP ST R15,8(,R1) SAVE IN PARM LIST CRP ST R6,TPCNLEN SAVE LENGTH CRP LA R15,TPCNLEN GET ADDRESS OF LENGTH CRP ST R15,4(,R1) SAVE ADDRESS IN PARM LIST CRP LA R15,SNDPKT GET ADDRESS OF DATA CRP ST R15,0(,R1) SAVE IN PARM LIST CRP OI 8(R1),X'80' INDICATE END OF PARM LIST CRP CALL TPUTCN DO TPUTCN CRP 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 LA R1,TGCNPRM GET ADDRESS OF PARM LIST CRP LA R15,130 CRP ST R15,4(,R1) SET LENGTH OF BUFFER CRP LA R15,RECPKT GET ADDRESS OF BUFFER CRP ST R15,0(,R1) SAVE IN PARM LIST CRP OI 4(R1),X'80' INDICATE END OF PARM LIST CRP CALL TGETCN DO TGETCN CRP 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 * NODEB TR RECPKT(130),ETOA CRP TSO17150 RDNODEB DS 0H CRP 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 LA R1,TPCNPRM SEND 1ST TO SERIES/1 CRP SR R4,R4 CLEAR R4 CRP ST R4,TPCNLEN SET LENGTH TO ZERO CRP LA R4,TPCNLEN GET ADDRESS OF ZERO LENGTH CRP ST R4,4(,R1) SAVE 0 LENGTH IN PARM LIST CRP LA R15,S1LAST GET ADDRESS OF S1LAST FLAG CRP ST R15,8(,R1) SAVE IN PARM LIST CRP OI 8(R1),X'80' LAST ELEMENT IN PARM LIST CRP CALL TPUTCN ISSUE WRITE SO WE CAN READ CRP ********************************************************************** 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 LA R15,1 SET R15 TO 1 CRP ST R15,S1LAST THIS IS LAST PACKET CRP XC LSDAT,LSDAT NO DATA TSO20700 L R15,=A(SPACK) TSO20710 BALR R14,R15 TSO20720 SR R15,R15 CLEAR R15 CRP ST R15,S1LAST CLEAR S1LAST FLAG CRP 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 TPCNPRM DC 2F'0' PARM LIST FOR TPUTCN CRP TGCNPRM DC 2F'0' PARM LIST FOR TGETCN CRP TPCNLEN DC 1F'0' LENGTH FOR ZERO LENGTH TPUT CRP S1LAST DC 1F'0' S1LAST FLAG FOR TPUTCN CRP * 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 *****************************< START OF TGETCN >************************TSO25240 TITLE 'TGETCN' 00010005 TGETCN CSECT 00020005 SAVE (14,12),,* 00030005 LR R12,R15 00040005 USING TGETCN,R12 00050005 GETMAIN R,LV=TGTLEN 00060005 ST R13,4(,R1) 00070005 ST R1,8(,R13) 00080005 LR R13,R1 00090005 USING TGTSTOR,R13 00100005 L R1,4(,R13) 00110005 L R1,24(,R1) 00120005 SPACE 00130005 L R6,0(,R1) GET BUFFER ADDRESS 00140005 L R5,4(,R1) GET ADDRESS OF LENGTH 00150005 L R7,0(,R5) GET LENGTH OF BUFFER 00160005 * 00260005 * R2 -> INPUT BUFFER 00270005 * R3 = BUFFER LENGTH 00280005 * 00300005 * READ TRANSPARENT INPUT 00310005 * 00320005 LA R2,IBUF1 GET ADDRESS OF BUFFER 00330005 LA R3,IBUF1L GET LENGTH OF BUFFER 00340005 TGET (R2),(R3),ASIS 00410005 LR R4,R1 SAVE RETURNED LENGTH 00411005 LA R2,3(,R2) BUMP PAST AID AND CURSOR ADDRESS 00412005 S R4,=F'3' LEN = LEN - 3 00412105 LTR R4,R4 IS LENGTH ZERO? 00412205 BZ FINI YES, ALL DONE THEN 00412305 BCTR R4,0 NO, MINUS 1 FOR COPY, TRANSLATE 00412405 EX R4,TRANS TRANSLATE TO EBCDIC 00413007 EX R4,COPY MOVE TEXT TO CALLERS 00414005 LA R4,1(,R4) + 1 AFTER EXECUTED INSTRUCTIONS 00415005 SPACE 00430005 FINI DS 0H 00440005 L R13,4(,R13) 00460005 L R1,8(,R13) 00470005 FREEMAIN R,LV=TGTLEN,A=(1) 00480005 ST R4,24(,R13) SAVE LENGTH IN REG 1 00481005 RETURN (14,12),,RC=0 00490005 BADPRM DS 0H 00500005 ABEND 13 00510005 * 00520005 * EXECUTED INSTRUCTIONS 00530005 * 00540005 COPY MVC 0(*-*,R6),0(R2) MOVE ESCAPE SEQUENCE TO OBUF 00550005 TRANS TR 0(*-*,R2),XTAB TRANSLATE TO EBCDIC 00560005 * 00570005 * THIS IS THE ASCII TO EBCDIC TABLE 00659305 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 00659405 * AB DC X'00010203372D2E2F1605250B0C0D0E0F' 0 00659507 * DC X'101112133C3D322618193F271C1D1E1F' 1 00659607 * DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' 2 00659707 * DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 3 00659807 * DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 4 00659907 * DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D' 5 00660007 * DC X'79818283848586878889919293949596' 6 00660107 * DC X'979899A2A3A4A5A6A7A8A9C04FD0A107' 7 00660207 * DC X'00010203372D2E2F1605250B0C0D0E0F' 8 00660307 * DC X'101112133C3D322618193F271C1D1E1F' 9 00660407 * DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' A 00660507 * DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' B 00660607 * DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' C 00660707 * DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D' D 00660807 * DC X'79818283848586878889919293949596' E 00660907 * DC X'979899A2A3A4A5A6A7A8A9C04FD0A107' F 00661007 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 00662007 XTAB DC X'000102030405060708090A0B0C0D0E0F' 0 00663007 DC X'101112131415161718191A1B1C1D1E1F' 1 00664007 DC X'202122232425262728292A2B2C2D2E2F' 2 00665007 DC X'303132333435363738393A3B3C3D3E3F' 3 00666007 DC X'404142434445464748494A4B4C4D4E4F' 4 00667007 DC X'505152535455565758595A5B5C5D5E5F' 5 00668007 DC X'606162636465666768696A6B6C6D6E6F' 6 00669007 DC X'707172737475767778797A7B7C7D7E7F' 7 00670007 DC X'000102030405060708090A0B0C0D0E0F' 8 00680007 DC X'101112131415161718191A1B1C1D1E1F' 9 00690007 DC X'202122232425262728292A2B2C2D2E2F' A 00700007 DC X'303132333435363738393A3B3C3D3E3F' B 00710007 DC X'404142434445464748494A4B4C4D4E4F' C 00720007 DC X'505152535455565758595A5B5C5D5E5F' D 00730007 DC X'606162636465666768696A6B6C6D6E6F' E 00740007 DC X'707172737475767778797A7B7C7D7E7F' F 00750007 SPACE 00830005 TGTSTOR DSECT 00840005 DS 18F 00850005 IBUF1 DS 1920C 00860005 IBUF1L EQU *-IBUF1 00870005 TGTLEN EQU *-TGTSTOR 00920005 R0 EQU 0 00930005 R1 EQU 1 00931005 R2 EQU 2 00932005 R3 EQU 3 00933005 R4 EQU 4 00934005 R5 EQU 5 00935005 R6 EQU 6 00936005 R7 EQU 7 00937005 R8 EQU 8 00938005 R9 EQU 9 00939005 R10 EQU 10 00939105 R11 EQU 11 00939205 R12 EQU 12 00939305 R13 EQU 13 00939405 R14 EQU 14 00939505 R15 EQU 15 00939605 END 00940005 *****************************< START OF TPUTCN >************************TSO25240 TITLE 'TPUTCN' 00150010 TPUTCN CSECT 00171010 SAVE (14,12),,* 00172010 LR R12,R15 00176010 USING TPUTCN,R12 00177010 GETMAIN R,LV=TPTLEN 00177110 ST R13,4(,R1) 00177210 ST R1,8(,R13) 00177310 LR R13,R1 00177410 USING TPTSTOR,R13 00177510 L R1,4(,R13) 00177610 L R1,24(,R1) 00177710 SPACE 00180010 * 00190010 * PARSE INPUT PARAMETERS 00200010 * 00210010 SPACE 00220010 TM 0(R1),X'80' IS 2ND PARM THERE? 00220110 BO BADPRM NO, RETURN 00220210 TM 4(R1),X'80' IS 3RD PARM THERE? 00220311 BO BADPRM NO, RETURN 00220411 TM 8(R1),X'80' MORE THAN THREE PARMS? 00220511 BZ BADPRM YES, RETURN 00220610 L R2,0(,R1) GET PARM 1 ADDRESS 00220710 L R4,4(,R1) GET ADDRESS OF BUFFER LENGTH 00220910 L R3,0(,R4) GET BUFFER LENGTH 00221010 L R4,8(,R1) GET ADDRESS OF S1LAST FLAG 00222011 L R4,0(,R4) GET S1LAST FLAG 00223011 SPACE 00230010 * 00230110 * R2 -> INPUT BUFFER 00231010 * R3 = BUFFER LENGTH 00232010 * R6 -> OUTPUT BUFFER CURRENT POSITION 00233010 * 00240010 * PRINT GRAPHICS STRING 00250010 * 00260010 SPACE 00270010 LR R11,R3 SAVE LENGTH 00273010 LTR R4,R4 IS S1LAST FLAG SET? 00274011 BNZ DOLAST YES, USE FINAL GRAPHICS STRING 00275011 MVC OBUF(GSTRL),GSTR MOVE S/1 GRAPHICS INTRO 00280010 B LASTEND SKIP AROUND OTHER 00280111 DOLAST DS 0H 00280211 MVC OBUF(GLSTRL),GLSTR MOVE S/1 FINAL GRAPHICS STRING 00280311 LASTEND DS 0H 00280411 C R3,=F'0' IS LENGTH ZERO? 00281010 BE DONE YES, WE ARE DONE 00282010 LA R6,OBUF+GSTRL BUMP PAST S/1 INTRODUCER 00290010 L0 L R10,=F'256' SET R10 TO 256 00290110 CR R3,R10 IS LENGTH > 256? 00290210 BH L1 YES, MOVE 256 BYTES 00290310 LR R10,R3 00290410 L1 DS 0H 00290510 BCTR R10,0 MINUS 1 FOR EXECUTED INSTRUCTION 00291010 EX R10,COPY MOVE ESCAPE SEQUENCE TO OBUF 00300010 * EX R10,TRANS TRANSLATE TO ASCII 00310012 LA R2,256(,R2) SKIP TO NEXT INPUT BUFFER BLOCK 00311010 LA R6,256(,R6) SKIP BY 256 IN OUTPUT BUFFER 00313010 S R3,=F'256' DECREMENT COUNT BY 256 00313110 BP L0 MOVE REMAINING TEXT 00314010 DONE DS 0H 00315010 LA R8,OBUF POINT TO OUTPUT STRING 00320010 LA R7,GSTRL(,R11) GET LENGTH FOR TPUT 00321010 TPUT (R8),(R7),NOEDIT OUTPUT STRING 00351010 SPACE 00410010 LTR R15,R15 00420010 BNZ BADPRM 00420110 L R13,4(,R13) 00420210 L R1,8(,R13) 00420310 FREEMAIN R,LV=TPTLEN,A=(1) 00420410 RETURN (14,12),,RC=0 00420510 BADPRM DS 0H 00421010 ABEND 13 00422010 * 00430010 * EXECUTED INSTRUCTIONS 00440010 * 00450010 COPY MVC 0(*-*,R6),0(R2) MOVE ESCAPE SEQUENCE TO OBUF 00460010 TRANS TR 0(*-*,R6),XTAB TRANSLATE TO ASCII 00470010 * 00480010 GSTR DS 0X 00490010 DC X'F1F0' WRITE 00500010 DC X'115D7F' S/1 TRANSPARENCY INTRODUCER 00510010 DC X'110001' S/1 TRANSPARENCY INTRODUCER 00520010 GSTRL EQU *-GSTR 00530010 GLSTR DS 0X 00540011 DC X'F1F0' WRITE 00550011 DC X'115D7F' S/1 TRANSPARENCY INTRODUCER 00551011 DC X'110000' S/1 TRANSPARENCY INTRODUCER 00552011 GLSTRL EQU *-GLSTR 00553011 * 00560010 * EBCDIC TO ASCII TRANSLATE TABLE (HIGH ORDER BIT SET) 00570010 * 00580010 *THIS IS THE EBCDIC TO ASCII CONVERSION TABLE 00590210 *CHARACTERS NOT REPRESENTABLE IN ASCII ARE REPLACED BY A NULL 00590310 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 00590410 XTAB DC X'80818283808980FF8080808B8C8D8E8F' 0 00590510 DC X'90919293808D8880989980809C9D9E9F' 1 00590610 DC X'80808080808A979B8080808080858687' 2 00590710 DC X'8080968080808084808080809495809A' 3 00590810 DC X'A080808080808080808080AEBCA8ABFC' 4 00590910 DC X'A6808080808080808080A1A4AAA9BBDE' 5 00591010 DC X'ADAF8080808080808080FCACA5DFBEBF' 6 00591110 DC X'808080808080808080E0BAA3C0A7BDA2' 7 00591210 DC X'80E1E2E3E4E5E6E7E8E980FB80808080' 8 00591310 DC X'80EAEBECEDEEEFF0F1F280FD80808080' 9 00591410 DC X'80FEF3F4F5F6F7F8F9FA808080DB8080' A 00591510 DC X'80808080808080808080808080DD8080' B 00591610 DC X'FBC1C2C3C4C5C6C7C8C9808080808080' C 00591710 DC X'FDCACBCCCDCECFD0D1D2808080808080' D 00591810 DC X'DC80D3D4D5D6D7D8D9DA808080808080' E 00591910 DC X'B0B1B2B3B4B5B6B7B8B9FC8080808080' F 00592010 SPACE 00760010 TPTSTOR DSECT 00770010 DS 18F 00780010 IBUF DS 1920C 00781010 IBUFL EQU *-IBUF 00782010 OBUF DS 0C 00790010 ORG *+GSTRL 00800010 DS 33000C 00810010 OBUFL EQU *-OBUF 00820010 TPTLEN EQU *-TPTSTOR 00830010 R0 EQU 0 00880010 R1 EQU 1 00881010 R2 EQU 2 00882010 R3 EQU 3 00883010 R4 EQU 4 00884010 R5 EQU 5 00885010 R6 EQU 6 00886010 R7 EQU 7 00887010 R8 EQU 8 00888010 R9 EQU 9 00889010 R10 EQU 10 00889110 R11 EQU 11 00889210 R12 EQU 12 00889310 R13 EQU 13 00889410 R14 EQU 14 00889510 R15 EQU 15 00889610 END 00889710