KERMIT TITLE 'KERMIT-CMS' KERMIT CSECT * KERMIT - * * Kermit - KL10 Error-free Reciprocol Micro Interface Transfer * Version 1.0 * * This program is the IBM VM/CMS side of a file transfer system. * It can be used to transfer files between a micro and a system * running under VM/CMS. * See the KERMIT manual for the complete program specifications * to which this program and any other component of the system * must adhere. * * Daphne Tzoar, Columbia University Center for Computing Activities * March 1982 * Updates: * June: Only allow Kermit to run on an ASCII terminal. Else, stop * execution. Also, check padding when receiving file in * fixed format. If only pad one character, pad the balance * via the "EX" option, else skip that command. * August: Change "FSREAD" when sending to allow a maximum of 133, not * the full buffer size since need two spaces for CRLF. * 4/7/83: Fix maximum number of tries on init (to 16), set timeout * value to 8, and do "CTL" function to padding character * in SINIT (not CHAR). * * Please address all comments and questions to: * 716 Watson * 612 W. 115th St. * NY,NY, 10025 * (212) 280-3703 * * Copyright (C) 1982 Columbia University * * Permission is granted to any individual or institution to copy * or use this program, except for explicitly commercial purposes. * * Note that this is an experimental version; all changes should * be forwarded to the author. * EJECT * REGISTER USAGE - * R1 - * R2 - * R3 - * R4 - * R5 - * R6 - * R7 - * R8 - * R9 - * R10 - * R11 - BASE REGISTER FOR GLOBAL DATA AREA * R12 - PROGRAM BASE * R13 - SAVE AREA * R14 - SUBROUTINE LINKAGE * R15 - SUBROUTINE LINKAGE * * EXTERNAL MACROS/MODULES CALLED - * The following MACLIBs should be GLOBAL'd: * CMSBSE, CMSLIB * * The following external routines are called: * NEXTFST ASSEMBLE * WILD ASSEMBLE * * SPACE * PRINT NOGEN REGEQU FSTD DSECT WILL NEED FOR NEXTFST ROUTINE ADT DSECT NUCON DSECT USE IN TOKENIZER ROUTINE EXTSECT DSECT USE WHEN TURNING BLIP OFF SPACE SOH EQU X'01' ^a FOR START OF HEADER CHAR AD EQU 68 DATA PACKET (ASCII 'D') AN EQU 78 NAK AZ EQU 90 EOF PACKET AS EQU 83 INIT PACKET AY EQU 89 ACK AF EQU 70 FILE PACKET AB EQU 66 BREAK PACKET AE EQU 69 ERROR PACKET ERCOD EQU 12 MEANS EOF WITH 'FSREAD' FLG1 EQU X'80' IS FILE THE FIRST OR NOT FLG2 EQU X'40' OVERWRITE SENT FILENAME? FLG3 EQU X'20' ONE = SENT ONLY PARTIAL RECORD FLG4 EQU X'10' NAK FROM MICRO(0) OR RPACK(1)? FLG5 EQU X'08' ALLOCATED MORE SPACE (DMSFREE) EJECT KERMIT CSECT STM R14,R12,12(R13) BALR R12,0 USING *,R12 LA R14,KSAVE ST R13,4(R14) ST R14,8(R13) LR R13,R14 * * USE R11 AS BASE REGISTER FOR THE SHARED DATA AREA L R11,=A(PARMS) USING PARMS,R11 LR R6,R1 HOLD ON TO CONSOLE BUFFER SR R2,R2 S R2,ONE GET INFO BY USING ADDR -1 DC X'83230024' GET LINESIZE DATA - DIAG 24 XC TEMP,TEMP ST R4,TEMP CLC TEMP(2),=X'8020' CHECK DEVICE TYPE BNE BADDEV MUST BE AN ASCII TERMINAL XC LINSIZ,LINSIZ STC R4,LINSIZ+3 SAVE THE LINESIZE LA R7,=C'TERM LINES 130' LA R8,14 DIAG 7,8,8 SET TO HIGHEST POSSIBLE VALUE USING NUCON,0 FOR TOKENIZER L R7,AEXTSECT LOC OF CMS ROUTINE EXTSECT USING EXTSECT,R7 MVC BLIP(1),TIMCHAR SAVE USER'S BLIP CHAR DMSEXS MVI,TIMCHAR,X'00' TURN OFF BLIP FOR NOW DROP R7 L R15,=A(INIT) BALR R14,R15 CALL THE INITIALIZATION SR R15,R15 ZERO RC INITIALLY (IF EXIT) LA R6,8(R6) CLC 0(8,R6),=8X'FF' ALL COMMAND ON ONE LINE? BNE NOPRO NO PROMPT IF YES PROMPT WRTERM 'KERMIT-CMS>',EDIT=NO RDTERM INPUT DMSKEY NUCLEUS LA R1,INPUT R1 GETS ADDRESS OF STRING L R0,=F'130' R0 GETS THE LENGTH L R15,ASCANN BALR R14,R15 DO TOKENIZING LR R6,R1 SAVE ADDR OF TOKENIZED LIST DMSKEY RESET NOPRO MVI ERRNUM,X'FF' RESET ERROR FOR THIS TIME CLI 0(R6),C'E' CHECK FOR 'EXIT' COMMAND BE LEAVE CLI 0(R6),C'Q' CHECK FOR 'QUIT' COMMAND BE LEAVE CLC 0(8,R6),=8X'FF' BARE CARRIAGE RETURN? BE PROMPT IGNORE IT CLI 0(R6),C'?' NEED HELP ? BNE SETCHK WRTERM 'Legal Commands are: ' WRTERM 'Receive, Send, Help, Exit, Quit, Set, Status, Show,* CMS, CP' B PROMPT SETCHK CLC 0(3,R6),=CL3'SET' IS IT THE SET COMMAND ? BE STSWITCH CLC 0(6,R6),=C'STATUS' IS IT THE STATUS COMMAND? BE STATSW CLC 0(3,R6),=C'SHO' IS IT THE SHOW COMMAND? BE SHOSW CLC 0(4,R6),=C'HELP' NEED HELP ? BE HELPSW CLC 0(3,R6),=C'CMS' CMS COMMAND? BE SYSCMD CLC 0(2,R6),=C'CP' CP COMMAND? BE SYSCMD OI FLAGS,FLG1 SET FLG1 - IT'S THE FIRST FILE NI FLAGS,X'FF'-FLG2 TURN OFF OVERWRITE FLAG (INIT) XC NFSENT,NFSENT NUMBER OF FILES SENT (= 0) CLC 0(3,R6),=C'REC' BNE SS MAYBE IT'S A SEND COMMAND LA R6,8(R6) PICK UP NEXT TOKEN CLI 0(R6),C'?' NEED HELP? BNE RR2 WRTERM 'Specify filename with format: [fn ft [fm]]' B PROMPT RR2 CLC 0(8,R6),=8X'FF' NO MORE WORDS ? BE RSWITCH NO MORE, GO READ CLI 0(R6),C'=' IS IT " = = FM" ? BNE RREG CLI 8(R6),C'=' IS FT ALSO '=' ? BNE BADFT MUST BE AN '=' CLI 16(R6),X'FF' NO FM GIVEN - ASSUME A1 BE RSWITCH MVC FM(2),16(R6) USE FM THEY SPECIFIED B RSWITCH RREG CLI 0(R6),C'*' NO WILDCARDS HERE BNE RR3 WRTERM 'Illegal file name' B PROMPT RR3 MVC FILNAM,=18X'20' BLANK IT OUT MVC FILNAM(8),0(R6) GET FN LA R6,8(R6) GET NEXT TOKEN CLI 0(R6),C'*' NOT ALLOWED BE BADFT CLI 0(R6),C'=' NOT ALLOWED BE BADFT CLC 0(8,R6),=8X'FF' NO MORE ? BNE RR BADFT WRTERM 'Illegal File Type' B PROMPT RR MVC FILNAM+8(8),0(R6) GET FTYPE OI FLAGS,FLG2 OVERWRITE RECEIVED FNAME MVC FILNAM+16(2),DFM DEFAULT FMODE,JUST IN CASE LA R6,8(R6) LOOK FOR FMODE CLC 0(8,R6),=8X'FF' IS IT THERE ? BE RSWITCH CLI 0(R6),C'*' NOT ALLOWED IN FM BE BADFM MVC FILNAM+16(2),0(R6) GET FMODE B RSWITCH GO TO READ PORTION BADFM WRTERM 'Illegal file mode' B PROMPT SS CLC 0(3,R6),=C'SEN' BNE ERR UNRECOGNIZED COMMAND LA R6,8(R6) PICK UP NEXT WORD CLI 0(R6),C'?' NEED HELP? BNE SS2 WRTERM 'Specify filename(s) with format: fn ft [fm]' B PROMPT SS2 CLC 0(8,R6),=8X'FF' NO MORE DATA ? BNE SNAM WRTERM 'Specify File Name' B PROMPT TRY AGAIN SNAM MVC NAME,=18X'20' BLANK IT OUT MVC FILNAM,=18X'20' BLANK IT OUT TOO MVC NAME(8),0(R6) PICK UP THE FNAME LA R6,8(R6) MOVE TO NEXT TOKEN CLC 0(8,R6),=8X'FF' NO MORE DATA ? BNE STYP WRTERM 'Specify File Type' B PROMPT STYP MVC NAME+8(8),0(R6) PICK UP THE FTYPE MVC NAME+16(2),DFM DEFAULT FMODE,JUST IN CASE LA R6,8(R6) LOOK FOR FMODE CLC 0(8,R6),=8X'FF' IS IT THERE? BE SSWITCH MVC NAME+16(2),0(R6) GET FMODE CLI 0(R6),C'*' WAS IT A WILDCARD? BNE SSWITCH NO PROBLEM IF NOT CLI 1(R6),C' ' NEED "**" OR "*NUMBER" BNE SSWITCH MVI NAME+17,C'*' SET "* " TO "**" B SSWITCH ERR WRTERM 'Invalid command' B PROMPT INVALID COMMAND - TRY AGAIN SPACE 3 SSWITCH EQU * LA 1,=C'SET LINEDIT OFF' LA 0,15 15 CHAR COMMAND DIAG 1,0,8 SHOW IT'S A CP COMMAND L R15,=A(SEND) BALR R14,R15 CALL SEND PORTION LTR R5,R15 CHECK RETURN CODE BNZ LINON MVI ERRNUM,X'FF' WORKED OK LINON LA 1,=C'SET LINEDIT ON' LA 0,14 DIAG 1,0,8 MVC OLDERR(1),ERRNUM ERROR SETTING OF THIS RUN TM FLAGS,FLG5 GOT EXTRA SPACE? BNO SSW1 NOPE, JUST LEAVE LA R0,4096/8 AMOUNT OF SPACE WE GOT L R1,STORLOC FIND IT & FREE IT DMSFRET DWORDS=(0),LOC=(1),ERR=*,MSG=NO NI FLAGS,X'FF'-FLG5 TURN OFF EXTRA SPACE FLAG SSW1 LTR R5,R5 CHECK THE RETCODE BZ PROMPT ALL OKAY WRTERM 'Error in sending file. Try again.' B PROMPT ERROR - TRY AGAIN RSWITCH EQU * LA 1,=C'SET LINEDIT OFF' LA 0,15 15 CHAR COMMAND DIAG 1,0,8 SHOW IT'S A CP COMMAND L R15,=A(RECEIVE) BALR R14,R15 CALL RECEIVE PORTION LTR R5,R15 CHECK RETURN CODE BNZ LNON MVI ERRNUM,X'FF' LNON LA 1,=C'SET LINEDIT ON' LA 0,14 DIAG 1,0,8 MVC OLDERR(1),ERRNUM ERROR SETTING OF THIS RUN LTR R5,R5 CHECK THE RETCODE BZ PROMPT ALL OKAY WRTERM 'Error in receiving file. Try again.' B PROMPT ERROR - TRY AGAIN STSWITCH EQU * L R15,=A(SET) BALR R14,R15 CALL "SET" SUBROUTINE LTR R15,R15 CHECK RETCODE BZ PROMPT WRTERM 'Illegal Set Command' B PROMPT SHOSW EQU * L R15,=A(SHOW) BALR R14,R15 CALL "SHOW" SUBROUTINE LTR R15,R15 CHECK RETCODE BZ PROMPT WRTERM 'Illegal Show Command' B PROMPT STATSW EQU * CLI 8(R6),C'?' NEED HELP? BNE GIVSTAT WRTERM 'Confirm with a carriage return' B PROMPT GIVSTAT CLI OLDERR,X'FF' WAS THERE AN ERROR LAST TIME? BNE FAIL WRTERM 'Kermit completed successfully' B PROMPT FAIL SR R5,R5 IC R5,OLDERR GET OFFSET INTO ERROR TABLE M R4,=F'20' OFFSET := ERRNUM * 20 LA R5,ERRTAB(R5) WRTERM (R5),20 PRINT ERROR MSG ON SCREEN B PROMPT AND LEAVE HELPSW CLI 8(R6),C'?' NEED HELP? BNE GIVHLP WRTERM 'Confirm with a carriage return' B PROMPT GIVHLP LA R1,HLPMSG GET LOCATION OF HELP MESSAGE SVC 202 SUPERVISOR CALL DC AL4(*+8) PRINT ERR MSG IF FAILED B PROMPT RETURN IF NO WRTERM 'No help available' B PROMPT SYSCMD CLI 8(R6),C'?' NEED HELP? BNE GIVSYS WRTERM 'Issue a CMS/CP command' B PROMPT GIVSYS CLC 8(8,R6),=8X'FF' ANY COMMAND? BE SYSERR DIE IF NO LA R1,0(R6) REST OF THE CMS COMMAND CLC 0(3,R6),=C'CMS' CMS OR CP COMMAND? BNE GIVSVC LA R1,8(R6) IGNORE THE "CMS" PART GIVSVC SVC 202 ISSUE THE COMMAND DC AL4(*+8) PRINT ERR MSG IF FAILED B PROMPT LR R5,R15 GET RETCODE LINEDIT TEXT='Command rc equals ........',SUB=(DEC,(R5)) B PROMPT SYSERR WRTERM 'No command supplied' B PROMPT LEAVE CLI 8(R6),C'?' NEED HELP? BNE KRET NO, JUST LEAVE WRTERM 'Confirm with a carriage return' B PROMPT BADDEV WRTERM 'An Ascii terminal must be used.' B RET KRET EQU * USING NUCON,0 USE TO RESET BLIP L R7,AEXTSECT ADDR OF EXTSECT USING EXTSECT,R7 RESTORE USER'S BLIP CHAR DMSEXS MVC,TIMCHAR(1),BLIP DROP R7 * RESTORE USER'S TERMINAL LINESIZE LINEDIT TEXT='TERM LINES ........',SUB=(DECA,LINSIZ), * DOT=NO,DISP=CPCOMM RET EQU * L R13,4(R13) L R14,12(R13) LM R0,R12,20(R13) BR R14 * KSAVE DS 18F KERMIT'S SAVE AREA LTORG DROP R11 DROP R12 NO LONGER NEED THEM EJECT INIT CSECT STM R14,R12,12(R13) BALR R12,0 USING *,R12 LA R14,ISAVE ST R13,4(R14) ST R14,8(R13) LR R13,R14 * * INITIALIZE VARIABLES THAT GET CHANGED DURING EXECUTION * USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA LIST L R11,=A(PARMS) USING PARMS,R11 XC SNDPKT,SNDPKT CLEAR OUT THESE BUFFERS XC RECPKT,RECPKT XC INPUT,INPUT LA R0,BUF LA R1,L'BUF ; CLEAR OUT THE BUFFER. SR R15,R15 MVCL R0,R14 LA R0,RBUF LA R1,L'RBUF SR R15,R15 MVCL R0,R14 XC FSENT,FSENT XC SDAT,SDAT XC RDAT,RDAT XC N,N SET VARIABLES TO ZERO XC NUM,NUM XC LSDAT,LSDAT XC LRDAT,LRDAT MVI FLAGS,X'00' CLEAR ALL FLAGS XC SAVPL,SAVPL XC RSAVPL,RSAVPL XC NUMTRY,NUMTRY MVC FILNAM,=18X'20' BLANK OUT FILNAM & NAME MVC NAME,=18X'20' MVI PREV,X'00' MVI ERRNUM,X'FF' SET TO NO ERROR FOR NOW MVI OLDERR,X'FF' SAME HERE MVC FST(4),=X'FF000000' MVC ADT(4),=X'FF000000' XC PKVAR,PKVAR ZERO IT OUT XC OLDTRY,OLDTRY XC SPSIZ,SPSIZ XC SIZE,SIZE XC TEMP,TEMP XC NFSENT,NFSENT ZERO FILES SENT,INITIALLY XC STORLOC,STORLOC MVC LRECL(1),DLRECL SET DEFAULTS, JUST IN CASE MVC RFM(1),DRECFM MVC FM(2),DFM MVC QUOCHAR(1),DQUOTE MVC RQUO(1),DQUOTE MVC REOL(1),DEOL MVC SEOL(1),DEOL MVI STATE,C' ' MVI STYPE,C' ' MVI RTYPE,C' ' * INITRET L R13,4(R13) L R14,12(R13) LM R0,R12,20(R13) BR R14 ISAVE DS 18F LTORG DROP R11 DROP R12 EJECT PARMS CSECT GLOBAL DATA LIST SNDPKT DS CL130 SEND THIS TO MICRO ORG SNDPKT PHDR DS X PLEN DS X PNUM DS X PTYPE DS X PDATA DS 0C ORG , RECPKT DS CL130 RECEIVE THIS FROM MICRO LSDAT DS F SEND PACKET SIZE LRDAT DS F RECEIVE PACKET SIZE FLAGS DC X'00' USE TO TEST OUR FLAGS FILINFO DC A(NAME) DATA FOR "NEXTFST" ROUTINE DC A(ADT) DC X'80',AL3(FST) HLPMSG DC CL8'HELP' USE FOR CMS 'HELP' COMMAND DC CL8'KERMIT' TOKENIZE TO 8 CHARACTERS DC 8X'FF' NO MORE INFO NAME DC 18X'20' NAME OF FILE(S) TO SEND DS 0F FST DC X'FF',AL3(0) USE FOR "NEXTFST" ROUTINE ADT DC X'FF',AL3(0) THIS TOO DS 0F INPUT DS CL130 INPUT BUFFER DS 0F BUF DS CL260 FSREAD INTO HERE RBUF DS CL260 FSWRITE FROM HERE FSENT DS CL160 TABLE OF FILES SENT SO FAR N DC F'0' SEND PACKET NUMBER NUM DC F'0' RECEIVE PACKET NUMBER NUMTRY DC F'0' TRIAL COUNTER FOR TRANSFERS OLDTRY DS F COUNTER FOR PREVIOUS PACKET NFSENT DC F'0' NUMBER OF FILES SENT STORLOC DS F POINTER TO EXTRA STORAGE MAXPACK DC F'94' MAX PACKET SIZE RECL DS F RECORD LEN (IF RECFM = V) RPSIZ DC F'94' MAX RECEIVE PACKET SIZE DSSIZ DC F'40' DEFAULT MAX SEND PACKET SIZE SPSIZ DS F SEND PACKET SIZE MAXTRY DC F'5' NO. OF TIMES TO RETRY PACKET IMXTRY DC F'16' NO. OF INITIAL TRIALS ALLOWED SIZE DS F MAX SIZE FOR SEND DATA DEL DC F'127' OCTAL 177 (DELETE CHAR) ZERO DC F'0' ONE DC F'1' FIVE DC F'5' TWO DC F'2' SPACE DC F'32' ASCII SPACE O1H DC F'64' OCTAL 100 O2H DC F'128' OCTAL 200 SAVPL DC F'0' POINTER WITHIN BUF,INIT=0 RSAVPL DC F'0' POINTER IN 'PTCHR',INIT=0 DQUOTE DC X'23' DEFAULT QUOTE CHARACTER = # QUOCHAR DS X QOUTE CHAR WE'LL SEND RQUO DS X MICRO'S QUOTE CHAR TEMP DS F TEMPORARY SPACE DS 0D PKVAR DS D USE FOR PICKING UP INTEGER SDAT DS CL130 TEMP PLACE FOR SEND DATA RDAT DS CL130 TEMP PLACE FOR RECEIVE DATA FILNAM DS CL18 SEND/REC FILENAME STATE DS C OUR CURRENT STATE DFM DC CL2'A1' DEFAULT FILEMODE FM DS CL2 FILEMODE USER WANTS DEOL DC X'0D' DEFAULT END OF PACKET (CR) REOL DS X EOL CHAR I NEED (CR) SEOL DS X EOL I'LL SEND DLRECL DC X'50' DEFAULT LRECL SIZE OF 80 LRECL DS X LRECL PROGRAM WILL USE DRECFM DC C'V' DEFAULT WITH VARIABLE RECFM RFM DS C RECFM PROGRAM WILL USE PREV DS C PREVIOUS CHAR REC (IN PTCHR) BLIP DS X SAVE USER'S BLIP CHAR LINSIZ DS F SAVE USER'S CONSOLE LINESIZE ERRNUM DS X ERROR NUMBER,IN CASE WE DIE OLDERR DS X ERROR OF PREVIOUS EXECUTION STYPE DS C TYPE OF PACKET SENT RTYPE DS C TYPE OF PACKET RECEIVED * THIS IS THE ASCII TO EBCDIC TABLE ATOE DC X'00010203372D2E2F1605250B0C0D0E0F' DC X'101112133C3D322618193F271C1D1E1F' DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D' DC X'79818283848586878889919293949596' DC X'979899A2A3A4A5A6A7A8A9C04FD0A107' *THIS IS THE EBCDIC TO ASCII CONVERSION TABLE *CHARACTERS NOT REPRESENTABLE IN ASCII ARE REPLACED BY A NULL ETOA DC X'000102030009007F0000000B0C0D0E0F' DC X'1011121300000800181900001C1D1E1F' DC X'00000000000A171B0000000000050607' DC X'0000160000000004000000001415001A' DC X'20000000000000000000002E3C282B7C' DC X'2600000000000000000021242A293B5E' DC X'2D2F00000000000000007C2C255F3E3F' DC X'000000000000000000603A2340273D22' DC X'00616263646566676869007B00000000' DC X'006A6B6C6D6E6F707172007D00000000' DC X'007E737475767778797A0000005B0000' DC X'000000000000000000000000005D0000' DC X'7B414243444546474849000000000000' DC X'7D4A4B4C4D4E4F505152000000000000' DC X'5C00535455565758595A000000000000' DC X'303132333435363738397C0000000000' * * TABLE OF ERROR MESSAGES (IN CASE WE ABORT) ERRTAB DC CL20'Bad send-packet size' ERR MSG #0 DC CL20'Bad message number' ERR MSG #1 DC CL20'Unrecognized state' ERR MSG #2 DC CL20'No SOH encountered' ERR MSG #3 DC CL20'Bad character count' ERR MSG #4 DC CL20'Bad checksum' ERR MSG #5 DC CL20'Disk is full' ERR MSG #6 DC CL20'Illegal packet type' ERR MSG #7 DC CL20'Lost a packet' ERR MSG #8 DC CL20'Micro sent a NAK' ERR MSG #9 DC CL20'Micro aborted' ERR MSG #10 DC CL20'Illegal file name' ERR MSG #11 DC CL20'Invalid lrecl' ERR MSG #12 DC CL20'Permanent I/O error' ERR MSG #13 DC CL20'Disk is read-only' ERR MSG #14 DC CL20'Recfm conflict' ERR MSG #15 DC CL20'Err allocating space' ERR MSG #16 LTORG EJECT SET CSECT STM R14,R12,12(R13) SAVE CALLER'S REGISTERS BALR R12,0 ESTABLISH ADDRESSABILITY USING *,R12 LA R14,SETSAVE ADDRESS OF MY SAVE AREA ST R13,4(R14) SAVE CALLER'S ST R14,8(R13) LR R13,R14 * USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA L R11,=A(PARMS) USING PARMS,R11 ESTABLISH ADDRESSABILITY LA R6,8(R6) PICK UP NEXT TOKEN CLI 0(R6),C'?' NEED HELP ? BNE NOQ WRTERM 'Recfm, End-of-Line, Quote, Lrecl, Packet-size' B SETOK NOQ CLC 0(5,R6),=CL5'RECFM' BNE NOREC LA R6,8(R6) PICK UP RECORD FORMAT CLI 0(R6),C'?' BNE CHKFM WRTERM 'f or v (default of v)' B SETOK CHKFM CLI 0(R6),C'V' REDUNDANT BE FMSET CLI 0(R6),C'F' FIXED FORMAT? BNE RECERR FMSET MVC RFM(1),0(R6) PICK UP RECFM B SETOK RECERR WRTERM 'Fixed and variable files only' B SETERR NOREC CLC 0(5,R6),=C'QUOTE' QUOTE CHARACTER BNE NOQUO LA R6,8(R6) GET NEXT TOKEN CLI 0(R6),X'FF' VALUE NOT SUPPLIED? BNE GIVQ WRTERM '?not confirmed' B SETERR GIVQ CLC 0(2,R6),=C'? ' BNE GETQUO WRTERM 'a single character' B SETOK GETQUO MVC QUOCHAR(1),0(R6) SET NEW QUOTE CHAR TR QUOCHAR(1),ETOA GET ASCII FORM CLI 1(R6),C' ' IS IT ONLY ONE CHAR? BE ISQOK WRTERM 'one character only' B SETERR ISQOK CLI QUOCHAR,X'21' CAN'T BE LESS THAN 32 BL BADQUO CLI QUOCHAR,X'7E' CAN'T BE LARGER THAN 126 BH BADQUO CLI QUOCHAR,X'3E' HAS TO BE BETWEEN 32-62 BNH SETOK CLI QUOCHAR,X'60' OR BETWEEN 96-126 BNL SETOK BADQUO WRTERM 'Must fall between 41-76,140,or 173-176 (octal).' B SETERR NOQUO CLC 0(5,R6),=C'LRECL' LRECL SIZE BNE NORCL LA R6,8(R6) PICK UP NEXT TOKEN CLI 0(R6),C'?' HELP ? BNE GETREC WRTERM 'Logical Record Length (default of 80).' B SETOK GETREC CLI 0(R6),X'FF' NO VALUE GIVEN BNE CALC WRTERM '?not confirmed' B SETERR CALC CLI 0(R6),X'F0' MUST BE >= TO 0 BL BADREC CLI 0(R6),X'F9' MUST BE <= TO 9 BH BADREC XC PKVAR,PKVAR EMPTY IT OUT SR R4,R4 LENGTH OF NUMBER CLI 1(R6),C' ' TWO DIGITS? BNE CALC2 EX R4,PCK B TST CALC2 LA R4,1(R4) ADD ONE CLI 2(R6),C' ' THREE DIGITS? BNE CALC3 EX R4,PCK B TST CALC3 LA R4,1(R4) IS THERE AN ERROR? CLI 3(R6),C' ' BNE BADREC EX R4,PCK TST CVB R7,PKVAR C R7,=X'00000085' MAX OF 133 FOR LRECL BH BADREC STC R7,LRECL SET THE LRECL VALUE B SETOK BADREC WRTERM 'A number with a maximum of 133.' B SETERR NORCL CLC 0(3,R6),=C'END' EOL CHARACTER BNE NOEND LA R6,8(R6) NEXT TOKEN CLI 0(R6),X'FF' NOT DATA BNE EOLCHAR WRTERM '?not confirmed' B SETERR EOLCHAR CLI 0(R6),C'?' NEED HELP? BNE GETEOL WRTERM 'A two digit number between 00 and 31 (dec).' B SETOK GETEOL CLI 0(R6),X'F0' MUST BE >= TO 0 BL BADEOL CLI 0(R6),X'F9' MUST BE <= TO 9 BH BADEOL XC PKVAR,PKVAR USE TO CONVERT VALUE CLI 1(R6),C' ' INPUT MUST BE TWO CHARS BE BADEOL CLI 2(R6),C' ' TWO CHARS, AT MAX BNE BADEOL PACK PKVAR(8),0(2,R6) PICK UP TWO CHARACTERS CVB R7,PKVAR PUT PACKED DECIMAL INTO REG C R7,=X'0000001F' MAX OF 31 DECIMAL BH BADEOL STC R7,SEOL SET SEND EOL VALUE B SETOK BADEOL WRTERM 'Must be a two digit value less than 31 (dec).' B SETERR NOEND CLC 0(3,R6),=C'PAC' CHANGE RECEIVE PACKET SIZE BNE SETERR LA R6,8(R6) GET NEXT TOKEN CLI 0(R6),X'FF' NO DATA BNE GETPAC WRTERM '?not confirmed' B SETERR GETPAC CLI 0(R6),C'?' NEED HELP? BNE CALC4 WRTERM 'Receive packet size (range: 26-94 decimal).' B SETOK CALC4 CLI 0(R6),X'F0' MUST BE >= TO 0 BL BADPAC CLI 0(R6),X'F9' MUST BE <= TO 9 BH BADPAC XC PKVAR,PKVAR USE TO CONVERT VALUE CLI 1(R6),C' ' INPUT MUST BE TWO CHARS BE BADPAC CLI 2(R6),C' ' TWO CHARS, AT MAX BNE BADPAC PACK PKVAR(8),0(2,R6) PICK UP TWO CHARS CVB R7,PKVAR PUT PACKED DECIMAL INTO REG C R7,=F'26' THIS IS MIN BL BADPAC C R7,MAXPACK THIS IS THE MAX BH BADPAC ST R7,RPSIZ USE THIS VALUE NOW B SETOK BADPAC WRTERM 'Must be between 26-94 (decimal).' SETERR MVC QUOCHAR(1),DQUOTE RESET VALUE, JUST IN CASE LA R15,4 SET A NON-ZERO RETCODE B SETRET SETOK SR R15,R15 RETCODE OF 0 * SETRET L R13,4(R13) L R14,12(R13) LM R0,R12,20(R13) BR R14 SETSAVE DS 18F PCK PACK PKVAR(8),0(0,R6) LTORG DROP R11 DROP R12 EJECT SHOW CSECT STM R14,R12,12(R13) SAVE CALLER'S REGISTERS BALR R12,0 ESTABLISH ADDRESSABILITY USING *,R12 LA R14,SHOWSAVE ADDRESS OF MY SAVE AREA ST R13,4(R14) SAVE CALLER'S ST R14,8(R13) LR R13,R14 * USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA L R11,=A(PARMS) USING PARMS,R11 ESTABLISH ADDRESSABILITY LA R6,8(R6) PICK UP NEXT TOKEN CLI 0(R6),C'?' NEED HELP ? BNE SHOREC WRTERM 'Recfm, End-of-Line, Quote, Lrecl, Packet-size' B SHOWOK SHOREC CLC 0(5,R6),=CL5'RECFM' BNE SHOQUO LINEDIT TEXT='The record format is ..',SUB=(CHARA,(RFM,1)) B SHOWOK SHOQUO CLC 0(5,R6),=C'QUOTE' BNE SHORCL TR QUOCHAR(1),ATOE GET EBCDIC VERSION LINEDIT TEXT='The quote character is ..', * SUB=(CHARA,(QUOCHAR,1)) TR QUOCHAR(1),ETOA KEEP THE ASCII FORM AROUND B SHOWOK SHORCL CLC 0(5,R6),=C'LRECL' BNE SHOEND SR R4,R4 ZERO IT OUT IC R4,LRECL LINEDIT TEXT='Lrecl is ........',SUB=(DEC,(R4)) B SHOWOK SHOEND CLC 0(3,R6),=C'END' BNE SHOPAC SR R4,R4 ZERO IT OUT IC R4,SEOL LINEDIT TEXT='End-of-Line character is ...... (decimal)', * SUB=(DEC,(R4)) B SHOWOK SHOPAC CLC 0(3,R6),=C'PAC' PACKET LENGTH ? BNE SHOWERR LINEDIT TEXT='Receive packet size is ........ (decimal)', * SUB=(DECA,RPSIZ) B SHOWOK SHOWERR LA R15,4 SET A NON-ZERO RETCODE B SHOWRET SHOWOK SR R15,R15 ZERO RETCODE * SHOWRET L R13,4(R13) L R14,12(R13) LM R0,R12,20(R13) BR R14 SHOWSAVE DS 18F LTORG DROP R11 DROP R12 EJECT SEND CSECT STM R14,R12,12(R13) SAVE CALLER'S REGISTERS BALR R12,0 ESTABLISH ADDRESSABILITY USING *,R12 LA R14,SENDSAVE ADDRESS OF MY SAVE AREA ST R13,4(R14) SAVE CALLER'S ST R14,8(R13) LR R13,R14 * USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA L R11,=A(PARMS) USING PARMS,R11 ESTABLISH ADDRESSABILITY MVI STATE,C'S' SR R3,R3 ST R3,N ST R3,NUMTRY MVC FST(4),=X'FF000000' INITIALIZATION STUFF MVC ADT(4),=X'FF000000' HERE TOO,IN CASE OF RETRY NXTFIL LA R1,FILINFO STUFF NEED TO GET FNAME(S) L R15,=V(NEXTFST) BALR R14,R15 GET NEXT/FIRST FILE LTR R5,R15 COPY RETCODE BNZ NOFIND RETCODE OF ZERO = ALL OK L R9,FST GET INFO FROM FSTTABLE USING FSTD,R9 MVC FILNAM(8),FSTFNAME GET FNAME MVC FILNAM+8(8),FSTFTYPE MVC FILNAM+16(2),FSTFMODE L R9,ADT USING ADTSECT,R9 LA R5,ADTM MVC FILNAM+16(1),0(R5) GET CORRECT FMODE LA R5,FSENT TABLE W/FILES SENT SO FAR LR R7,R5 KEEP TRACK OF TABLE LA R7,160(R7) HERE, WE'RE PAST THE TABLE L R4,NFSENT HOW MANY SENT SO FAR FILLOOP LTR R4,R4 BZ OKSND BCTR R4,0 DECREMENT COUNTER CLC 0(16,R5),FILNAM SENT ALREADY? BE NXTFIL DON'T RESEND LA R5,16(R5) CHECK NEXT FILE CR R5,R7 BNE FILLOOP L R5,STORLOC SEARCH HERE NOW B FILLOOP OKSND TM FLAGS,FLG1 IS THIS THE FIRST FILE? BNO SLOOP ONLY WAIT 10 SECS IF YES NI FLAGS,X'FF'-FLG1 TURN OFF FIRST FILE FLAG LA 1,=C'SL 10 SEC' SLEEP BEFORE SENDING LA 0,9 COMMAND LENGTH IS 9 DIAG 1,0,8 SHOW IT'S A CP COMMAND SLOOP CLI STATE,C'D' SEND DATA STATE BE SDATA CLI STATE,C'F' SEND FILE STATE BE SFILE CLI STATE,C'S' SEND INIT STATE BE SINIT CLI STATE,C'Z' END OF FILE STATE BE SEOF CLI STATE,C'B' SEND BREAK STATE BE SBREAK CLI STATE,C'C' COMPLETE STATE BE COMPLETE CLI STATE,C'A' ABORT STATE BE ABORT ERROR - GO TO ABORT STATE MVI ERRNUM,X'02' UNRECOGNIZED STATE B ABORT OTHERWISE, DIE SINIT CLC NUMTRY,IMXTRY SEE IF CAN SEND BL OK1 YES WE CAN MVI STATE,C'A' NOPE, GO INTO ABORT STATE B SLOOP OK1 L R5,SPACE MAKE CHARACTER PRINTABLE A R5,RPSIZ ADD REC PACKET SIZE STC R5,SDAT ADD SIZE INFO TO BUFFER L R5,SPACE A R5,=F'8' 8 FOR TIMEOUT STC R5,SDAT+1 L R5,SPACE SEND ZERO + " " FOR NPAD STC R5,SDAT+2 WE'RE THE SLOW GUYS SR R5,R5 PAD WITH NULLS L R3,O1H XR R5,R3 CTL FUNCTION (XOR WITH 64) STC R5,SDAT+3 DON'T NEED PADCHAR EITHER SR R5,R5 ZERO IT OUT FOR NEXT TWO GUYS IC R5,REOL EOL CHAR I NEED A R5,SPACE MAKE PRINTABLE STC R5,SDAT+4 IC R5,QUOCHAR MY QUOTE CHAR STC R5,SDAT+5 L R3,NUMTRY LA R3,1(R3) INCREMENT TRIAL COUNTER ST R3,NUMTRY MVI STYPE,AS PACKET TYPE = SEND INITIATE MVC LSDAT(4),=F'6' BUFFER SIZE FOR THIS SEND L R4,DSSIZ GET DEFAULT SPSIZ S R4,FIVE FOR NOW, USE DEFAULT SPSIZ.... ST R4,SIZE ....TO SET VALUE OF SIZE L R15,=A(SPACK) GET ADDRESS OF ROUTINE 'SPACK' BALR 14,15 SAVE * AND GO TO SPACK CLI STATE,C'A' BE ABORT L 15,=A(RPACK) GET ADDRESS OF 'RPACK' BALR 14,15 SAVE * AND GO TO RPACK CLI RTYPE,AE ERROR PACKET? BNE Y1 NO, THEN MAYBE AN ACK MVI ERRNUM,X'0A' MICRO DIED MVI STATE,C'A' AND DIE B SLOOP Y1 CLI RTYPE,AY SEE IF GOT ACK BNE N1 MAYBE IT'S 'N' CLC N,NUM CHECK MESSAGE NUMBERS BE AOK1 MVI ERRNUM,X'08' PACKET LOST B SLOOP AOK1 SR R4,R4 ZERO OUT REGISTER IC R4,RDAT USE SPSIZ THE MICRO WANTS S R4,SPACE SUBTRACT THE ' ' C R4,=F'26' BUFFER HAS TO BE >= 26 BNL CH1 SO FAR, SO GOOD MVI STATE,C'A' ABORT THEN MVI ERRNUM,X'00' INVALID DATA-PACKET-SIZE ERROR B SLOOP CH1 C R4,MAXPACK MAX PACKET SIZE BNH CH2 CONTINUE IF <= TO MAX MVI STATE,C'A' DIE MVI ERRNUM,X'00' INVALID DATA-PACKET-SIZE ERROR B SLOOP CH2 STC R4,SPSIZ+3 USE SPSIZ THE MICRO WANTS S R4,FIVE ST R4,SIZE SET SIZE TO SPSIZ-5 CLC LRDAT(4),=F'4' USING DEFAULTS? BNH NOCHG YUP LA R5,RDAT POINTER TO THE BUFFER SR R7,R7 IC R7,4(R5) SEOL MICRO WANTS S R7,SPACE UNCHAR (IE - SUBTRACT SPACE) STC R7,SEOL NOCHG MVI STATE,C'F' PUT INTO SEND FILE STATE XC NUMTRY,NUMTRY RESET TO ZERO L R3,N LA R3,1(R3) ADD ONE ST R3,N STORE VALUE INCREMENTED BY 1 NC N(4),=X'0000003F' MASK TO GET MOD 64 B SLOOP N1 CLI RTYPE,AN SEE IF IT'S 'N' BNE AB1 IF NOT, DIE TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED? BO SLOOP LEAVE ERR MSG AS IS IF I DID MVI ERRNUM,X'09' MICRO NAK'ED B SLOOP AB1 MVI STATE,C'A' ELSE, ABORT MVI ERRNUM,X'07' UNRECOGNIZED PACKET TYPE B SLOOP SFILE CLC NUMTRY,MAXTRY EXCEEDED NO. OF TRIES ALLOWED? BL OK2 NOPE, STILL OK MVI STATE,C'A' ABORT IF YES B SLOOP OK2 TR FILNAM,ETOA LA R4,FILNAM BEGINNING OF BUFFER SR R1,R1 TRT FILNAM(8),PARSE SEND A DOT INSTEAD OF PARSES BNZ SP L R4,=F'8' FUDGE THE LENGTH B SP2 SP SR R1,R4 WHERE THE TRT STOPPED LR R4,R1 HAVE LENGTH OF THE FN SP2 LR R5,R4 COUNTER FOR LENTH OF FILNAM BCTR R4,0 ONE LESS FOR 'EX' COMMAND EX R4,FIRST PICK UP THE FN LA R4,SDAT(R5) PUT THE DOT HERE MVI 0(R4),X'2E' ADD AN ASCII DOT LA R5,1(R5) ADD ONE TO COUNTER LA R4,FILNAM LA R4,8(R4) NEXT AREA OF THE FILNAM SR R1,R1 TRT FILNAM+8(8),PARSE BNZ SP3 L R4,=F'8' FUDGE THE LENGTH B SP4 SP3 SR R1,R4 LR R4,R1 WHERE WE STOPPED SP4 LA R7,SDAT(R5) NEXT FREE SPOT AR R5,R4 LENGTH OF NAME WITH DOT BCTR R4,0 MINUS ONE FOR THE 'EX' EX R4,SECOND PICK UP FT L R3,NUMTRY LA R3,1(R3) INCREMENT TRIAL COUNTER ST R3,NUMTRY MVI STYPE,AF PACKET TYPE = FILE HEADER ST R5,LSDAT SET BUFFER SIZE TR FILNAM,ATOE L R3,NFSENT LR R4,R3 SAVE VALUE C R4,=F'10' NEED MORE SPACE? BE ADDSP BH ADDSP2 M R2,=F'16' GET OFFSET INTO TABLE LA R3,FSENT(R3) POINTER INTO TABLE MVC 0(16,R3),FILNAM SAVE FILENAME YOU'RE SENDING LA R4,1(R4) INCREMENT NUMBER OF FILES SENT ST R4,NFSENT B SNDFIL ADDSP LA R0,4096/8 GET 4K BLOCK DMSFREE DWORDS=(0),ERR=ERRSP,MSG=NO ST R1,STORLOC POINTS TO EXTRA DATA AREA OI FLAGS,FLG5 GOT MORE SPACE (TURN ON FLAG) ADDSP2 LR R3,R4 GET CORRECT LENGTH AGAIN S R3,=F'10' GET PROPER POINTER M R2,=F'16' OFFSET INTO TABLE A R3,STORLOC LOC IN TABLE MVC 0(16,R3),FILNAM SAVE FILENAME LA R4,1(R4) INCREMENT FILE COUNTER ST R4,NFSENT B SNDFIL ERRSP MVI ERRNUM,X'10' ERR ALLOCATING MORE SPACE MVI STATE,C'A' ABORT NOW B SLOOP SNDFIL L R15,=A(SPACK) GET ADDRESS OF 'SPACK' BALR 14,15 SAVE * AND GO TO SPACK CLI STATE,C'A' BE ABORT L 15,=A(RPACK) GET ADDRESS OF 'RPACK' BALR 14,15 SAVE * AND GO TO RPACK CLI RTYPE,AE ERROR PACKET? BNE Y2 MAYBE AN ACK MVI ERRNUM,X'0A' MICRO DIED MVI STATE,C'A' SO WE DO TOO B SLOOP Y2 CLI RTYPE,AY SEE IF GOT ACK BNE N2 MAYBE GOT AN 'N' CLC N,NUM DO WE HAVE THE CORRECT ACK? BE AOK2 MVI ERRNUM,X'08' MISSING A PACKET SOMEWHERE B SLOOP AOK2 MVI STATE,C'D' PREPARE FOR SEND-DATA STATE XC NUMTRY,NUMTRY RESET COUNTER L R3,N LA R3,1(R3) ADD ONE ST R3,N STORE INCREMENTED VALUE NC N(4),=X'0000003F' MASK TO GET MOD 64 L 15,=A(GTCHR) BALR 14,15 DO GET-CHAR AND COME BACK B SLOOP N2 CLI RTYPE,AN BNE AB2 ELSE, DIE TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED? BO SLOOP LEAVE ERR MSG AS IS IF I DID MVI ERRNUM,X'09' MICRO NAK'ED B SLOOP AB2 MVI STATE,C'A' ELSE, ABORT MVI ERRNUM,X'07' UNRECOGNIZED PACKET TYPE B SLOOP SDATA CLC NUMTRY,MAXTRY CAN WE DO IT? BL OK4 YES MVI STATE,C'A' ELSE ABORT B SLOOP OK4 L R3,NUMTRY LA R3,1(R3) INCREMENT COUNTER ST R3,NUMTRY MVI STYPE,AD PACKET TYPE = DATA L R15,=A(SPACK) BALR 14,15 GO TO SPACK AND RETURN CLI STATE,C'A' BE ABORT L 15,=A(RPACK) BALR 14,15 SAME FOR RPACK CLI RTYPE,AE ERROR PACKET? BNE Y4 MAYBE AN ACK MVI ERRNUM,X'0A' MICRO DIED MVI STATE,C'A' SO WE DO TOO B SLOOP Y4 CLI RTYPE,AY SEE IF GOT 'ACK' BNE N4 SEE IF IT'S AN 'N' CLC N,NUM DO WE HAVE THE CORRECT ACK? BE AOK4 MVI ERRNUM,X'08' MISSING A PACKET B SLOOP AOK4 XC NUMTRY,NUMTRY RESET COUNTER L R3,N LA R3,1(R3) INCREMENT COUNTER ST R3,N NC N(4),=X'0000003F' MASK TO GET MOD 64 L 15,=A(GTCHR) BALR 14,15 DO GET-CHAR AND RETURN B SLOOP N4 CLI RTYPE,AN BNE AB4 TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED? BO SLOOP LEAVE ERR MSG AS IS IF I DID MVI ERRNUM,X'09' MICRO NAK'ED B SLOOP AB4 MVI STATE,C'A' MVI ERRNUM,X'07' ILLEGAL PACKET TYPE B SLOOP SEOF CLC NUMTRY,MAXTRY CAN WE DO IT? BL OK5 BRANCH IF YES MVI STATE,C'A' ABORT IF NO B SLOOP OK5 L R3,NUMTRY LA R3,1(R3) ADD ONE ST R3,NUMTRY STORE INCREMENTED COUNTER MVI STYPE,AZ PACKET TYPE = EOF XC LSDAT,LSDAT LENGTH OF ZERO L R15,=A(SPACK) BALR 14,15 SAVE * AND GO TO SPACK CLI STATE,C'A' BE ABORT L 15,=A(RPACK) BALR 14,15 SAME FOR RPACK CLI RTYPE,AE ERROR PACKET? BNE Y5 MAYBE AN ACK MVI ERRNUM,X'0A' MICRO DIED MVI STATE,C'A' SO WE DO TOO B SLOOP Y5 CLI RTYPE,AY CHECK FOR 'ACK' BNE N5 MAYBE WAS A 'NAK' CLC N,NUM CORRECT ACK? BE AOK5 MVI ERRNUM,X'08' LOST A PACKET B SLOOP AOK5 L R3,N LA R3,1(R3) ADD ONE ST R3,N STORE VALUE INCREMENTED BY 1 NC N(4),=X'0000003F' MASK TO GET MOD 64 MVI STATE,C'F' SET TO SEND FILE FOR NOW B NXTFIL GET-NEXT-FILE NOFIND TM FLAGS,FLG1 DID IT DIE ON FIRST TRY? BNO DIEOK NO ONES == NOT FIRST WRTERM 'File not found' MVI STATE,C'A' ABORT THIS ONE B SLOOP DIEOK MVI STATE,C'B' BREAK CONNECTION B SLOOP N5 CLI RTYPE,AN BNE AB5 DIE IF NOT A NAK TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED? BO SLOOP LEAVE ERR MSG AS IS IF I DID MVI ERRNUM,X'09' MICRO NAK'ED B SLOOP AB5 MVI STATE,C'A' ELSE, ABORT MVI ERRNUM,X'07' UNRECOGNIZED PACKET TYPE B SLOOP SBREAK CLC NUMTRY,MAXTRY OVER OUR LIMIT? BL OK6 BRANCH IF NO MVI STATE,C'A' ABORT IF YES B SLOOP OK6 L R3,NUMTRY LA R3,1(R3) ADD ONE ST R3,NUMTRY INCREMEMTED TRIAL COUNTER MVI STYPE,AB PACKET TYPE = BREAK XC LSDAT,LSDAT LENGTH = ZERO L R15,=A(SPACK) BALR 14,15 SAVE * AND GO TO SPACK CLI STATE,C'A' BE ABORT L 15,=A(RPACK) BALR 14,15 SAVE * AND GO TO RPACK CLI RTYPE,AE ERROR PACKET? BNE Y6 MAYBE AN ACK MVI ERRNUM,X'0A' MICRO DIED MVI STATE,C'A' THEN WE DO TOO B SLOOP Y6 CLI RTYPE,AY CHECK FOR ACK BNE N6 CHECK FOR 'N' CLC N,NUM CORRECT ACK? BE AOK6 MVI ERRNUM,X'08' LOST A PACKET B SLOOP AOK6 MVI STATE,C'C' COMPLETED STATE B SLOOP N6 CLI RTYPE,AN CHECK FOR 'N' BNE AB6 DIE IF NOT A NAK TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED? BO SLOOP LEAVE ERR MSG AS IS IF I DID MVI ERRNUM,X'09' MICRO NAK'ED B SLOOP AB6 MVI STATE,C'A' ELSE,ABORT MVI ERRNUM,X'07' UNRECOGNIZED PACKET TYPE B SLOOP GTCHR LA R3,FILNAM GET ADDRESS OF 'FILNAM' FSOPEN (R3),FORM=E OPEN FILE FOR I/O TM FLAGS,FLG3 SEE IF THERE'S STUFF IN BUF BO STUFF ONES -> STUFF'S THERE FSREAD (R3),BUFFER=BUF,BSIZE=256,FORM=E LTR R4,R15 PUT RESULT OF READ IN R4 BZ OK8 C R4,=A(ERCOD) RETCODE OF 12 MEANS EOF BNE ERR1 TRY IT AGAIN MVI STATE,C'Z' MAKE TO EOF STATE FSCLOSE (R3) CLOSE FILE BR R14 ERR1 MVI STATE,C'A' ABORT ON FILE SYSTEM ERROR MVI ERRNUM,X'0C' INVALID RECORD LENGTH C R4,=F'8' WAS OUR GUESS RIGHT? BER R14 IF YES, RETURN MVI ERRNUM,X'0D' ELSE, GOT AN I/O ERROR BR R14 OK8 LR R5,R0 GET NUMBER OF BYTES READ IN LR R4,R5 SAVE ALSO IN R4 BCTR R4,0 SUBTRACT 1 FOR EX COMMAND EX R4,TRANS EBCDIC TO ASCII TRANSLATION LA R8,BUF GET LOCATION OF BUFFER INPUT LA R9,BUF(R4) LAST POSITION IN THAT BUFFER X4 CLI 0(R9),X'20' IS THIS A BLANK? BNE X5 NO, FOUND LAST CHAR OF LINE BCTR R9,0 CR R9,R8 BNL X4 FIND LAST CHAR SR R5,R5 ALL BLANKS B FOO X5 SR R9,R8 LR R5,R9 LENGTH OF LINE LA R5,1(R5) ADD ONE FOO LA R9,BUF(R5) FIRST BLANK SPACE AFTER DATA MVC 0(1,R9),=X'0D' ADD ASCII CR LA R9,1(R9) INCREMENT POINTER MVC 0(1,R9),=X'0A' AND ADD ASCII LF LA R5,2(R5) TWO EXTRA BYTES OF DATA NOW ST R5,RECL LRECL + 2 (FOR CRLF) SR R8,R8 ZERO OUT INDEX FOR BUF STUFF SR R9,R9 SAME FOR INDEX FOR SDAT SR R10,R10 CHARACTER COUNTER SR R5,R5 WILL HOLD QUOCHAR IC R5,QUOCHAR L R8,SAVPL WHERE WE LEFT OFF C R8,RECL SEE IF ARE AT LIMIT BNL FULL2 LEAVE IF REACHED OR EXCEEDED SR R7,R7 LOOP IC R7,BUF(R8) PICK UP BYTE CR R7,R5 IS IT THE QUOTE CHARACTER? BE SPECIAL C R7,DEL IS IT THE CHARDEL? BE SPECIAL C R7,SPACE IS IT A CONTROL CHARACTER? BL SPECIAL B ADDIT SPECIAL L R4,SIZE MUNGE VALUE WHILE IN R4 SR R4,R10 FIND DIF BETWWEN THE TWO C R4,TWO SEE IF HAVE AT LEAST 2 BYTES BNL ROOM YES,CAN ADD STC R10,LSDAT+3 SET LSDAT TO VAL OF COUNTER OI FLAGS,FLG3 SET FLAG TO SHOW STUFF'S THERE ST R8,SAVPL SAVE PLACE IN BUF BR 14 LEAVE THIS ROUTINE ROOM LA R4,SDAT(R9) WHERE IT'S GOING MVC 0(1,R4),QUOCHAR MOVE QUOTE CHAR THERE LA R9,1(R9) INCREMENT SDAT COUNTER LA R10,1(R10) INCREMENT CHARACTER COUNTER CR R7,R5 DON'T ADD ^O100 TO THIS BE ADDIT IT'S ALREADY PRINTABLE A R7,O1H ADD ^O100 TO CHAR N R7,=X'0000007F' GET MOD ^O200 ADDIT STC R7,SDAT(R9) ADD THE CHARACTER LA R9,1(R9) INCREMENT SDAT COUNTER LA R8,1(R8) INCREMENT BUF COUNTER LA R10,1(R10) INCREMENT CHARACTER COUNTER C R8,RECL SEE IF REACHED LIMIT BNL FULL2 C R9,SIZE SEE IF REACHED LIMIT BNL FULL B LOOP FULL EQU * STC R10,LSDAT+3 THIS ONE TOO ST R8,SAVPL HERE TOO OI FLAGS,FLG3 TURN ON FLAG - STUFF IN BUF BR 14 FULL2 EQU * STC R10,LSDAT+3 THIS ONE TOO XC SAVPL,SAVPL RESET THIS NI FLAGS,X'FF'-FLG3 TURN OFF LEFTOVER DATA FLAG BR 14 * ABORT LA R3,FILNAM FSCLOSE (R3) CLOSE THE FILE TM FLAGS,FLG1 DYING ON FILE-NOT-FOUND? BO NOERRP IF SO, THEN NO ERROR PACKET CLI ERRNUM,X'0A' DID THE MICRO DIE? BE NOERRP NO ERROR PACKET IF SO MVI STYPE,AE ERROR PACKET MVC LSDAT(4),=F'20' ALL MSGS ARE THIS LONG MVC N(4),NUM SYNCH PACKET NUMBERS SR R5,R5 IC R5,ERRNUM GET RIGHT MESSAGE NUMBER M R4,=F'20' OFFSET := ERRNUM * 20 LA R5,ERRTAB(R5) MVC SDAT(20),0(R5) SPACK NEEDS THE DATA HERE TR SDAT(20),ETOA L R15,=A(SPACK) BALR R14,R15 SEND ERROR PACKET & DIE NOERRP LA R15,4 SET NON-ZERO RETCODE B SENDRET PREPARE TO LEAVE COMPLETE SR R15,R15 ZERO WILL BE RETCODE SENDRET L R13,4(R13) L R14,12(R13) LM R0,R12,20(R13) BR R14 SENDSAVE DS 18F TRANS TR BUF(0),ETOA EBCDIC TO ASCII TRANSLATION TRNS TR SNDPKT(0),ATOE BACK FROM ASCII TO EBCDIC PARSE DC 32X'00' DC X'01' STOP ON A SPACE DC 223X'00' FIRST MVC SDAT(0),FILNAM PICK UP THE FN SECOND MVC 0(0,R7),FILNAM+8 PICK UP FT LTORG DROP R11 DROP R12 DON'T NEED THEM ANYMORE EJECT SPACK CSECT STM R14,R12,12(R13) SAVE CALLER'S REGISTERS BALR R12,0 ESTABLISH ADDRESSABILITY USING *,R12 LA R14,SPSAVE ADDRESS OF MY SAVE AREA ST R13,4(R14) SAVE CALLER'S ST R14,8(R13) LR R13,R14 * USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA L R11,=A(PARMS) USING PARMS,R11 ESTABLISH ADDRESSABILITY SR R9,R9 MVI PHDR,SOH ADD CONTROL-A TO PACKET CLC LSDAT,SIZE NEED DATA SIZE <= SPSIZ-5 BNH FINE MVI ERRNUM,X'00' DATA SIZE EXCEEDS MAX LIMIT MVI STATE,C'A' ABORT ON THIS B SPRET FINE L R4,=F'35' USE ^o43 TO OFFSET DATA A R4,LSDAT ADD IT TO LSDAT STC R4,PLEN AR R9,R4 AND THEN ADD IT TO CHECKSUM CLC N,ZERO CHECK IF N IS VALID BNL T1 OK IF >= TO 0 MVI ERRNUM,X'01' ILLEGAL MESSAGE NUMBER MVI STATE,C'A' B SPRET T1 CLC N,O1H SEE IF IS <= OCTAL 100 BNH T2 MVI ERRNUM,X'01' ILLEGAL MESSAGE NUMBER MVI STATE,C'A' B SPRET T2 L R4,SPACE OFFSET THIS VALUE TOO A R4,N ADD IT TO N ST R4,TEMP MVC PNUM(1),TEMP+3 A R9,TEMP AND ADD TO CHECKSUM CLI STYPE,X'41' ASCII 'A' BL T3 CAN'T BE LESS THAN THIS CLI STYPE,X'5A' ASCII 'Z' BNH T4 CAN'T BE GREATER T3 MVI ERRNUM,X'07' ILLEGAL PACKET TYPE MVI STATE,C'A' DIE ON THIS B SPRET T4 MVC PTYPE(1),STYPE ADD MESSAGE TYPE SR R2,R2 ZERO IT OUT IC R2,STYPE AR R9,R2 ADD TO CHECKSUM L R6,LSDAT HOW MUCH DATA LTR R6,R6 TEST IT OUT BZ NODAT SR R5,R5 USE TO GET DATA SR R3,R3 USE TO HOLD DATA DATCHK IC R3,SDAT(R5) PICK UP CHAR AR R9,R3 ADD TO CHECKSUM LA R5,1(R5) BUMP POINTER BCTR R6,0 LTR R6,R6 MORE DATA? BNZ DATCHK NODAT L R6,LSDAT WILL NEED THIS LATER LR R7,R6 MUNGE WHILE IN R7 BCTR R7,0 SUBTRACT 1 FOR EX FUNCTION EX R7,MOVE MOVE THE DATA TO SNDPKT ST R9,TEMP WE'LL NEED THIS SOON N R9,=X'000000C0' GET MOD 192 M R8,ONE CARRY OVER THE SIGN BIT D R8,O1H GET MOD 64 A R9,TEMP ADD THE TWO VALUES N R9,=X'0000003F' GET MOD 64 OF CHECKSUM A R9,SPACE ADD OFFSET STC R9,PDATA(R6) ADD CHECKSUM AFTER DATA LA R6,1(R6) MOVE POINTER IC R9,SEOL ADD SEND END OF PACKET CHAR STC R9,PDATA(R6) LA R6,5(R6) VALUE OF LSDAT+5 TR SNDPKT(130),ATOE SEND IN EBCDIC WRTERM SNDPKT,(R6),EDIT=NO SPRET L R13,4(R13) L R14,12(R13) LM R0,R12,20(R13) BR 14 SPSAVE DS 18F MOVE MVC PDATA(0),SDAT LTORG DROP R11 DROP R12 DON'T NEED THEM ANYMORE EJECT RPACK CSECT STM R14,R12,12(R13) SAVE CALLER'S REGISTERS BALR R12,0 ESTABLISH ADDRESSABILITY USING *,R12 LA R14,RPSAVE ADDRESS OF MY SAVE AREA ST R13,4(R14) SAVE CALLER'S ST R14,8(R13) LR R13,R14 * USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA L R11,=A(PARMS) USING PARMS,R11 ESTABLISH ADDRESSABILITY RDTERM RECPKT,EDIT=NO TR RECPKT(130),ETOA NI FLAGS,X'FF'-FLG4 ASSUME MICRO'LL NAK-NOT RPACK SR R8,R8 INDEX REG FOR RECPKT SR R5,R5 CHECKSUM REGISTER TRY LA R7,RECPKT(R8) ADDRESS OF CHARACTER CLI 0(R7),SOH IS IT CONTROL-A BE READIN YES; SO FAR, SO GOOD LA R8,1(R8) TRY NEXT CHARACTER C R8,=F'130' SEE IF EXCEED BUFFER BL TRY MVI ERRNUM,X'03' NO "SOH" ERROR B BADP READIN SR R9,R9 ZERO OUT INDEX REG FOR RDAT LA R8,1(R8) INCREMENT COUNTER LA R7,RECPKT(R8) PICK UP LOC OF CHAR COUNT CLI 0(R7),SOH IS IT CONTROL-A BE READIN START OVER CLC 0(1,R7),DQUOTE COUNT+' '+3 AND ^d35 BNL CONT CONTINUE IF >= MVI ERRNUM,X'04' BAD LENGTH ATTRIBUTE B BADP CONT IC R5,0(R7) START CHECKSUM LR R7,R5 MUNGE IN R7 TO GET LRDAT S R7,=F'35' LENGTH OF DATA STC R7,LRDAT+3 LA R8,1(R8) INCREMENT SR R7,R7 ZERO IT OUT IC R7,RECPKT(R8) PICK UP PACKET NUMBER C R7,=A(SOH) IS IT CONTROL-A BE READIN AR R5,R7 ADD TO CHECKSUM S R7,SPACE SUBTRACT THE ' ' STC R7,NUM+3 NUM := RECEIVED PACKET NO. LA R8,1(R8) INCREMENT COUNTER IC R7,RECPKT(R8) PICK UP MESSAGE TYPE C R7,=A(SOH) IS IT CONTROL-A BE READIN AR R5,R7 ADD TO CHECKSUM STC R7,RTYPE PUT INTO RTYPE LA R8,1(R8) GO TO NEXT BYTE L R4,LRDAT COUNTER TO GET ALL DATA LUP C R4,ZERO SEE IF PICKED UP ALL DATA BE FIN XC TEMP,TEMP ZERO IT OUT LA R7,RECPKT(R8) NEXT LOCATION IN BUFFER MVC TEMP+3(1),0(R7) PICK UP NEXT BYTE CLI TEMP+3,SOH IS IT CONTROL-A BE READIN LA R7,RDAT(R9) WHERE THE DATA'S GOING MVC 0(1,R7),TEMP+3 AND MOVE IT A R5,TEMP ADD TO CHECKSUM LA R8,1(R8) ADD ONE LA R9,1(R9) ADD ONE BCTR R4,0 DECREMENT COUNTER B LUP FIN SR R7,R7 ZERO OUT REGISTER IC R7,RECPKT(R8) GET CHECKSUM C R7,=A(SOH) IS IT CONTROL-A BE READIN ST R5,TEMP WE'LL NEED THIS SOON N R5,=X'000000C0' GET MOD 192 M R4,ONE CARRY OVER THE SIGN BIT D R4,O1H GET MOD 64 A R5,TEMP ADD THE TWO VALUES N R5,=X'0000003F' GET MOD 64 A R5,SPACE ADD OFFSET CR R5,R7 COMPUTED VS RECEIVED CHECKSUM BE RPRET LINEDIT TEXT='CHK SB ...',SUB=(HEX,(R5)) MVI ERRNUM,X'05' BAD CHECKSUM ERROR BADP MVI RTYPE,AN RETURN A NAK OI FLAGS,FLG4 RPACK NAK'ED THE PACKET RPRET L R13,4(R13) L R14,12(R13) LM R0,R12,20(R13) BR 14 RPSAVE DS 18F LTORG DROP R11 DROP R12 DON'T NEED THEM ANYMORE EJECT RECEIVE CSECT STM R14,R12,12(R13) SAVE CALLER'S REGISTERS BALR R12,0 ESTABLISH ADDRESSABILITY USING *,R12 LA R14,RECSAVE ADDRESS OF MY SAVE AREA ST R13,4(R14) SAVE CALLER'S ST R14,8(R13) LR R13,R14 * USE R11 AS BASE REGISTER FOR THE GLOBAL DATA AREA, 'PARMS' L R11,=A(PARMS) USING PARMS,R11 SR R6,R6 GET ZERO ST R6,NUMTRY ZERO THIS OUT ST R6,N HERE TOO MVI STATE,C'R' SET TO RECEIVE STATE RLOOP CLI STATE,C'D' RECEIVE DATA STATE BE RDATA CLI STATE,C'F' RECEIVE FILE STATE BE RFILE CLI STATE,C'R' RECEIVE INIT STATE BE RINIT CLI STATE,C'C' COMPLETE STATE BE RCOMP CLI STATE,C'A' ABORT STATE BE RABORT MVI ERRNUM,X'02' UNRECOGNIZED STATE B RABORT ELSE, DIE RINIT CLC NUMTRY,IMXTRY SEE IF CAN RECEIVE BL ROK1 YES, WE CAN MVI STATE,C'A' NOPE, GO INTO ABORT STATE B RLOOP ROK1 L R3,NUMTRY LA R3,1(R3) INCREMENT TRIAL COUNTER ST R3,NUMTRY L R4,DSSIZ DEFAULT SEND PACKET SIZE S R4,FIVE USE DEFAULT TO SET "SIZE" ST R4,SIZE IN CASE WE DIE BEFORE IT'S SET L R15,=A(RPACK) GET INIT INFORMATION BALR R14,R15 CLI RTYPE,AE ERROR PACKET? BNE RY1 ALL OK MVI ERRNUM,X'0A' MICRO DIED MVI STATE,C'A' SO WE DO TOO B RLOOP RY1 CLI RTYPE,AS IS IT A SEND-INIT PACKET BNE RN1 MAYBE IT GOT CLOBBERED SR R4,R4 ZERO OUT REGISTER IC R4,RDAT GET FIRST CHARACTER S R4,SPACE SUBTRACT THE ' ' C R4,=F'26' MIN SPACK SIZE BNL RCH1 SO FAR, SO GOOD MVI STATE,C'A' ELSE, ABORT MVI ERRNUM,X'00' INVALID DATA-PACKET-SIZE ERROR B RLOOP RCH1 C R4,MAXPACK MAX PACKET SIZE BNH RCH2 MVI STATE,C'A' ABORT IF SIZE IS ILLEGAL MVI ERRNUM,X'00' BAD SEND DATA LENGTH B RLOOP RCH2 STC R4,SPSIZ+3 USE THE VALUE AS SEND SIZE S R4,FIVE ST R4,SIZE SET IT TO SPSIZ-5 CLC LRDAT(4),=F'4' USING ALL DEFAULTS ? BNH NOCH YUP LA R5,RDAT POINT TO THE BUFFER SR R7,R7 IC R7,4(R5) SEOL THE MICRO WANTS S R7,SPACE UNCHAR (SUBTRACT ' ') STC R7,SEOL CLC LRDAT(4),FIVE ANY MORE DATA? BNH NOCH JUST USE DEFAULTS MVC RQUO(1),5(R5) SET NEW QUOCHAR VALUE NOCH MVC N(4),NUM SYNCH PACKET NUMBERS MVI STYPE,AY SET MESSAGE TYPE TO ACK MVC LSDAT(4),=F'6' SET LENGTH OF DATA SENDING L R5,SPACE MAKE CHARACTER PRINTABLE A R5,RPSIZ ADD REC PACKET SIZE STC R5,SDAT ADD SIZE INFO TO BUFFER L R5,SPACE A R5,=F'8' 8 FOR TIMEOUT STC R5,SDAT+1 L R5,SPACE SEND ZERO + " " FOR NPAD STC R5,SDAT+2 WE'RE THE SLOW GUYS SR R5,R5 PAD WITH NULLS L R3,O1H XR R5,R3 CTL FUNCTION (XOR WITH 64) STC R5,SDAT+3 DON'T NEED PADCHAR EITHER SR R5,R5 ZERO IT OUT FOR NEXT TWO GUYS IC R5,REOL EOL CHAR I NEED A R5,SPACE MAKE PRINTABLE STC R5,SDAT+4 IC R5,QUOCHAR MY QUOTE CHAR STC R5,SDAT+5 L R15,=A(SPACK) ADDRESS OF SPACK BALR R14,R15 SAVE * AND GO TO SPACK CLI STATE,C'A' BE RABORT MVI STATE,C'F' SET TO RECEIVE FILE STATE MVC OLDTRY(4),NUMTRY SAVE TRIAL COUNTER XC NUMTRY,NUMTRY RESET COUNTER TO ZERO L R3,N LA R3,1(R3) ADD ONE ST R3,N STORE VALUE INCREMENTED BY 1 NC N(4),=X'0000003F' MASK TO GET MOD 64 B RLOOP RN1 CLI RTYPE,AN MAYBE IT'S A NAK BNE RSELSE MVI STYPE,AN SEND A NAK PACKET XC LSDAT,LSDAT NO DATA L R15,=A(SPACK) BALR R14,R15 B RLOOP RSELSE MVI STATE,C'A' ELSE,ABORT MVI ERRNUM,X'07' ILLEGAL PACKET TYPE B RLOOP RFILE CLC NUMTRY,MAXTRY EXCEEDED NO. OF TRIALS ALLOWED BL ROK2 NOPE, STILL OK MVI STATE,C'A' ABORT IF YES B RLOOP ROK2 L R3,NUMTRY LA R3,1(R3) INCREMENT TRIAL COUNTER ST R3,NUMTRY L R15,=A(RPACK) GET ADDRESS OF RPACK BALR R14,R15 GO THERE AND RETURN WHEN DONE CLI RTYPE,AE ERROR PACKET? BNE RY2 MAYBE AN ACK MVI ERRNUM,X'0A' MICRO DIED MVI STATE,C'A' SO WE DO TOO B RLOOP RY2 CLI RTYPE,AS STILL IN INIT STATE? BNE RNZ TRY FOR AN EOF CLC OLDTRY,MAXTRY CAN WE TRY AGAIN? BL ROLD MVI STATE,C'A' ELSE, ABORT B RLOOP ROLD L R3,OLDTRY LA R3,1(R3) INCREMENT COUNTER ST R3,OLDTRY L R3,N GET PACKET NUMBER SENT BCTR R3,0 SUBTRACT ONE FROM IT C R3,NUM NUM MUST EQUAL N-1 BE RNUM MVI ERRNUM,X'08' PREVIOUS PACKET MISSING B RNAK SEND A NAK RNUM MVI STYPE,AY ACK PACKET ST R3,N MAKE SEND SEQ NO. = N-1 MVC LSDAT(4),=F'6' SET DATA LENGTH VARIABLE L R15,=A(SPACK) BALR R14,R15 GO TO SPACK AND RETURN CLI STATE,C'A' BE RABORT L R4,N LA R4,1(R4) ADD ONE ST R4,N RESTORE N TO PROPER VALUE XC NUMTRY,NUMTRY RESET COUNTER TO ZERO B RLOOP RNZ CLI RTYPE,AZ BNE RNF MAYBE IT'S AN 'F' CLC OLDTRY,MAXTRY CAN WE TRY AGAIN? BL ROLD2 MVI STATE,C'A' ELSE,ABORT B RLOOP ROLD2 L R3,OLDTRY LA R3,1(R3) INCREMENT COUNTER ST R3,OLDTRY L R3,N GET PACKET NUMBER SENT BCTR R3,0 SUBTRACT ONE FROM IT C R3,NUM NUM MUST EQUAL N-1 BE RNUM2 MVI ERRNUM,X'08' PREVIOUS PACKET MISSING B RNAK SEND A NAK RNUM2 MVI STYPE,AY ACK PACKET ST R3,N SEND SEQ := N-1 XC LSDAT,LSDAT NO DATA L R15,=A(SPACK) BALR R14,R15 CLI STATE,C'A' BE RABORT L R4,N LA R4,1(R4) ADD ONE ST R4,N RESTORE N TO PROPER VALUE LA R3,FILNAM FSCLOSE (R3) CLOSE FILE WHEN DONE XC NUMTRY,NUMTRY RESET COUNTER TO ZERO B RLOOP RNF CLI RTYPE,AF BNE RNB WELL, IT'S NOT A FNAME CLC NUM,N THEY HAVE TO BE EQUAL BE RNUM3 MVI ERRNUM,X'08' PREVIOUS PACKET MISSING B RNAK SEND A NAK RNUM3 MVI STYPE,AY ACK PACKET XC LSDAT,LSDAT NO DATA TM FLAGS,FLG2 OVERWRITE THE NAME SENT? BO OVER YUP,WE DO L R5,LRDAT GET SIZE OF FILNAM LTR R5,R5 CHECK LENGTH BZ SAYNO DIE IF NO FILENAME SR R9,R9 USE AS POINTER WITHIN BUFFER LA R9,RDAT(R9) GET LOC OF FIRST CHAR LR R8,R9 REMDOT CLC 0(1,R9),=X'2E' LOOK FOR THE DOT BE DOT FOUND IT LA R9,1(R9) NEXT POSITION LR R10,R9 SR R10,R8 GET LENGTH OF NAME SO FAR CR R10,R5 AT END OF FN? BL REMDOT NO,KEEP LOOKING B SAYNO DIE IF NO DOT AT ALL DOT LR R5,R9 SAVE OUR PLACE LA R5,1(R5) NEXT CHARACTER SR R9,R8 GET LENGTH OF FNAME LR R4,R9 SAVE LENGTH ATTRIBUTE BCTR R4,0 C R9,=F'8' MAX OF 8 CHARACTERS BNH DOT2 L R9,=F'8' TRUNCATE EXTRA LETTERS DOT2 BCTR R9,0 FOR EX COMMAND LTR R9,R9 CHECK LENGTH BM SAYNO DIE IF IT'S ZERO MVC FILNAM,=18X'20' INITIALIZE TO BLANKS EX R9,GETFN GET FILNAM L R7,LRDAT GET LENGTH OF WHOLE NAME SR R7,R4 AND GET LENGTH OF FTYPE S R7,=F'3' LTR R7,R7 CHECK LENGTH BM SAYNO DIE IF ZERO C R7,=F'7' MAX IS 8 (7 + 1 FOR 'EX') BNH DOT3 L R7,=F'7' TRUNCATE EXTRA LETTERS DOT3 EX R7,GETFT GET FTYPE TR FILNAM(18),ATOE NEED IT IN EBCDIC MVC FILNAM+16(2),FM ADD DEFAULT FMODE OVER L R15,=A(SPACK) BALR R14,R15 SEND ACK CLI STATE,C'A' BE RABORT OC FILNAM,=CL18' ' UPPERCASE FILENAME LA R3,FILNAM FSOPEN (R3),FORM=E MVC OLDTRY(4),NUMTRY KEEP NUMTRY FOR LATER XC NUMTRY,NUMTRY RESET TO ZERO L R3,N LA R3,1(R3) ADD ONE ST R3,N INCREMENT COUNTER NC N(4),=X'0000003F' MASK TO GET MOD 64 MVI STATE,C'D' DATA RECEIVE STATE B RLOOP RNB CLI RTYPE,AB SEE IF IT'S A BREAK BNE RNN MAYBE GOT A NAK CLC NUM,N BE RNUM4 MVI ERRNUM,X'08' PREVIOUS PACKET MISSING B RNAK SEND A NAK RNUM4 MVI STYPE,AY ACK PACKET XC LSDAT,LSDAT NO DATA L R15,=A(SPACK) BALR R14,R15 CLI STATE,C'A' BE RABORT MVI STATE,C'C' COMPLETE STATE B RLOOP RNN CLI RTYPE,AN SEE IF GOT A NAK BNE RNELSE RNAK MVI STYPE,AN SEND A NAK PACKET XC LSDAT,LSDAT NO DATA L R15,=A(SPACK) BALR R14,R15 B RLOOP DO NOTHING ON A NAK RNELSE MVI STATE,C'A' ABORT OTHERWISE MVI ERRNUM,X'07' ILLEGAL PACKET TYPE B RLOOP RDATA CLC NUMTRY,MAXTRY HAVE WE EXCEEDED OUR LIMIT? BL ROK3 MVI STATE,C'A' ELSE, ABORT B RLOOP ROK3 L R4,NUMTRY LA R4,1(R4) INCREMENT ST R4,NUMTRY SAVE INCREMENTED COUNTER L R15,=A(RPACK) BALR R14,R15 CALL RPACK CLI RTYPE,AE ERROR PACKET? BNE RY3 MAYBE AN ACK MVI ERRNUM,X'0A' MICRO DIED MVI STATE,C'A' WE ABORT TOO B RLOOP RY3 CLI RTYPE,AD IS THIS A DATA PACKET? BNE RDF MAYBE IT'S AN FNAME PACKET CLC N,NUM CHECK FOR RIGHT PACKET BNE DIF L R15,=A(PTCHR) BALR R14,R15 PUT CHARACTERS INTO FILE LTR R7,R7 CHECK FOR NO ERROR BZ OKWR NO ERROR MVI STATE,C'A' ABORT ON FILE SYSTEM ERROR B RLOOP OKWR MVI STYPE,AY ACK PACKET XC LSDAT,LSDAT NO DATA L R15,=A(SPACK) BALR R14,R15 CLI STATE,C'A' BE RABORT MVC OLDTRY(4),NUMTRY SAVE NUMTRY'S VALUE IN OLDTRY XC NUMTRY,NUMTRY RESET NUMTRY L R3,N LA R3,1(R3) ST R3,N INCREMENT COUNTER NC N(4),=X'0000003F' MASK TO GET MOD 64 B RLOOP DIF CLC OLDTRY,MAXTRY CAN WE DO IT? BL DIFNUM MVI STATE,C'A' AND ABORT B RLOOP DIFNUM L R4,OLDTRY LA R4,1(R4) ST R4,OLDTRY INCREMENT THIS COUNTER L R4,N BCTR R4,0 C R4,NUM NUM MUST EQUAL N-1 BE DIFOK MVI ERRNUM,X'08' PREVIOUS PACKET MISSING B RDN1 SEND A NAK DIFOK XC NUMTRY,NUMTRY RESET COUNTER TO ZERO MVI STYPE,AY ACK PACKET XC LSDAT,LSDAT NO DATA ST R4,N SET N TO N-1 TO RESEND PACKET L R15,=A(SPACK) BALR R14,R15 SEND THE PACKET CLI STATE,C'A' BE RABORT L R4,N LA R4,1(R4) ADD ONE ST R4,N RESTORE N TO PROPER VALUE B RLOOP AND RETURN RDF CLI RTYPE,AF SENDING FILENAME AGAIN? BNE RDZ CLC OLDTRY,MAXTRY CAN WE DO IT? BL FILOVER TRYING IT AGAIN MVI STATE,C'A' IF NO, ABORT B RLOOP FILOVER L R4,OLDTRY LA R4,1(R4) ST R4,OLDTRY SAVE INCREMENTED VALUE L R4,N BCTR R4,0 NEED VALUE OF N-1 C R4,NUM N-1 MUST EQUAL NUM BE FILOK MVI ERRNUM,X'08' PREVIOUS PACKET MISSING B RDN1 SEND A NAK FILOK XC NUMTRY,NUMTRY RESET TO ZERO XC LSDAT,LSDAT NO DATA MVI STYPE,AY ACK PACKET AGAIN ST R4,N SET N TO N-1 FOR NOW TM FLAGS,FLG2 OVERWRITE THE NAME SENT? BO OVRWRT YUP, WE DO L R5,LRDAT GET SIZE OF FILNAM LTR R5,R5 CHECK LENGTH BZ SAYNO DIE IF NO FILENAME SR R9,R9 USE AS POINTER WITHIN BUFFER LA R9,RDAT(R9) GET LOC OF FIRST CHAR LR R8,R9 RMDOT CLC 0(1,R9),=X'2E' LOOK FOR THE DOT BE ADOT FOUND IT LA R9,1(R9) NEXT POSITION LR R10,R9 SR R10,R8 GET LENGTH OF NAME SO FAR CR R10,R5 AT THE END OF THE FILNAM ? BL RMDOT NO,KEEP LOOKING B SAYNO DIE IF NO DOT AT ALL ADOT LR R5,R9 SAVE OUR PLACE LA R5,1(R5) NEXT CHARACTER SR R9,R8 GET LENGTH OF FNAME LR R6,R9 SAVE LENGTH ATTRIBUTE BCTR R6,0 C R9,=F'8' MAX OF 8 CHARACTERS BNH DT2 L R9,=F'8' TRUNCATE EXTRA LETTERS DT2 BCTR R9,0 FOR EX COMMAND LTR R9,R9 CHECK LENGTH BM SAYNO DIE IF IT'S ZERO MVC FILNAM,=18X'20' INITIALIZE TO BLANKS EX R9,GETFN GET FILNAM L R7,LRDAT GET LENGTH OF WHOLE NAME SR R7,R6 AND GET LENGTH OF FTYPE S R7,=F'3' LTR R7,R7 CHECK LENGTH BM SAYNO DIE IF ZERO C R7,=F'7' MAX IS 8 (7 + 1 FOR 'EX') BNH DT3 L R7,=F'7' TRUNCATE EXTRA LETTERS DT3 EX R7,GETFT GET FTYPE TR FILNAM(18),ATOE NEED IT IN EBCDIC MVC FILNAM+16(2),FM ADD DEFAULT FMODE OVRWRT L R15,=A(SPACK) BALR R14,R15 CLI STATE,C'A' BE RABORT OC FILNAM,=CL18' ' UPPERCASE FILENAME LA R3,FILNAM GET FILE NAME FSOPEN (R3),FORM=E OPEN FILE FOR WRITING L R4,N LA R4,1(R4) ADD ONE ST R4,N RESTORE N TO PROPER VALUE B RLOOP AND RETURN RDZ CLI RTYPE,AZ IS THIS AN EOF PACKET? BNE RDN CLC N,NUM ARE THEY EQUAL BE RDOK MVI ERRNUM,X'08' PREVIOUS PACKET MISSING B RDN1 SEND A NAK RDOK MVI STYPE,AY ACK THE PACKET XC LSDAT,LSDAT NO DATA L R15,=A(SPACK) BALR R14,R15 LA R3,FILNAM FSCLOSE (R3) MVC OLDTRY(4),NUMTRY SAVE NUMTRY'S VALUE HERE XC NUMTRY,NUMTRY AND RESET COUNTER L R3,N LA R3,1(R3) ST R3,N STORE VALUE INCREMENTED BY 1 NC N(4),=X'0000003F' MASK TO GET MOD 64 MVI STATE,C'F' TRY FOR ANOTHER FILE B RLOOP RDN CLI RTYPE,AN DO WE NEED TO SEND A NAK? BNE RDELSE RDN1 MVI STYPE,AN SEND A NAK XC LSDAT,LSDAT NO DATA L R15,=A(SPACK) BALR R14,R15 B RLOOP RDELSE MVI STATE,C'A' UNRECOGNIZED PACKET - ABORT MVI ERRNUM,X'07' ILLEGAL PACKET TYPE B RLOOP SAYNO MVI STYPE,AN SEND A NAK PACKET XC LSDAT,LSDAT NO DATA MVI ERRNUM,X'0B' ILLEGAL FILENAME ERROR L R15,=A(SPACK) BALR R14,R15 B RLOOP PTCHR SR R4,R4 USE TO HOLD QUOCHAR SR R6,R6 USE TO HOLD LRECL SR R8,R8 COUNTER WITHIN RDAT L R9,RSAVPL COUNTER WITHIN RBUF IC R4,RQUO IC R6,LRECL L R5,LRDAT COUNTER TO GET ALL DATA RLUP SR R7,R7 USE TO PICK UP CHAR LTR R5,R5 MORE DATA LEFT? BNZ MOR LEAVE IF ALL DONE CLI PREV,X'4D' ARE WE IN MIDDLE OF LINE? BER R14 LEAVE IF NOT ST R9,RSAVPL SAVE OUR PLACE SR R7,R7 ZERO RETCODE BR R14 MOR BCTR R5,0 DECREMENT CHAR COUNTER IC R7,RDAT(R8) GET DATA FROM RDAT CR R7,R4 IS IT THE QUOTE CHARACTER? BNE REGULAR BCTR R5,0 DECREMENT CHAR COUNT LA R8,1(R8) MOVE POINTER IC R7,RDAT(R8) PICK UP SPECIAL CHAR C R7,=X'0000004D' IS IT A CR? (CHAR(CR)) BNE NOCR WRITE OUT RECORD IF YES MVI PREV,X'4D' JUST HAD A CR LA R8,1(R8) IGNORE CONTROL CHAR B RFIN NOCR C R7,=X'0000004A' HOW ABOUT A LF? (CHAR(LF)) BNE NOLF IF YES, WRITE OUT RECORD LA R8,1(R8) IGNORE CONTROL CHAR CLI PREV,X'4D' WAS LAST THING CR? BNE RFIN NOPE, THEN KEEP ON B RLUP IGNORE LF IF PREV=CR NOLF CR R7,R4 IS IT THE QUOCHAR BE REGULAR DON'T CONVERT IF IT IS A R7,O1H ADD ^O100 N R7,=X'0000007F' GET MOD ^O200 REGULAR STC R7,RBUF(R9) STORE CHAR IN RBUF LA R9,1(R9) MOVE RBUF COUNTER LA R8,1(R8) MOVE RDAT COUNTER MVI PREV,X'00' BLANK OUT CR IF WAS THERE C R9,=F'255' ONLY 256 CHARS ALLOWED BNH RLUP AND CONTINUE LR R10,R9 USE MAX LENGTH OF 256 B WRFIL AND WRITE TO FILE RFIN LTR R10,R9 GET DATA SIZE BZ FUDGE GOTTA FAKE A BLANK LINE C R7,=X'0000004D' IS IT A CR? (CHAR(CR)) BE WRFIL C R7,=X'0000004A' HOW ABOUT A LF? (CHAR(LF)) BE WRFIL ST R10,RSAVPL SAVE DATA RECEIVED SO FAR SR R7,R7 ZERO RETCODE BR 14 FUDGE MVI RBUF,X'20' MAKE FIRST CHAR A SPACE LA R10,1(R10) LENGTH OF ONE WRFIL XC RSAVPL,RSAVPL RESET THE POINTER TR RBUF(256),ATOE MAKE EBCDIC AGAIN LA R3,FILNAM CLI RFM,C'V' IS IT VARIABLE FORMAT? BE VAR CR R10,R6 BH PUR IGNORE DATA AFTER LRECL VALUE CR R10,R6 PAD OUT TO LRECL SIZE ? BE VAR NOPE, IT'S OK. LR R2,R6 GET LRECL SIZE SR R2,R10 PAD WITH THIS MANY SPACES BCTR R2,0 MINUS ONE FOR THE 'EX' LA R9,RBUF(R10) START PADDING HERE MVI 0(R9),C' ' PUT IN THE FIRST SPACE LTR R2,R2 BZ PUR DON'T PAD IF SIZE DIF WAS ONE BCTR R2,0 SUBRTRACT SPACE WE JUST ADDED EX R2,PAD PAD OUT BUFFER PUR LR R10,R6 LENGTH HAS TO BE THIS SIZE VAR SR R6,R6 IC R6,RFM RECFM HAS TO BE IN A REGISTER FSWRITE (R3),BUFFER=RBUF,BSIZE=(R10),RECFM=(R6),FORM=E LR R7,R15 CHECK THE RETCODE SR R9,R9 START AT BEGINNING OF RBUF LTR R7,R7 CHECK RETCODE BZ RLUP GET NEXT LINE IF OK C R7,=A(ERCOD) IS THE DISK READ-ONLY? BNE WRERR1 MVI ERRNUM,X'0E' BR R14 WRERR1 MVI ERRNUM,X'0F' ASSUME A RECFM CONFLICT C R7,=F'16' FILE EXISTS W/DIF RECFM BER R14 MVI ERRNUM,X'06' DISK FULL ERROR BR R14 * RABORT LA R3,FILNAM FSCLOSE (R3) CLOSE OPEN FILE CLI ERRNUM,X'0A' DID THE MICRO DIE? BE RNOERRP NO ERROR PACKET IF SO MVI STYPE,AE ERROR PACKET MVC LSDAT(4),=F'20' ALL MSGS ARE THIS LONG MVC N(4),NUM SYNCH PACKET NUMBERS SR R5,R5 IC R5,ERRNUM M R4,=F'20' OFFSET := ERRNUM * 20 LA R5,ERRTAB(R5) MVC SDAT(20),0(R5) SPACK NEEDS THE DATA HERE TR SDAT(20),ETOA L R15,=A(SPACK) BALR R14,R15 SEND ERROR PACKET & DIE RNOERRP LA R15,4 SET A NON-ZERO RETCODE B RECRET PREPARE TO LEAVE RCOMP SR R15,R15 RETCODE OF ZERO RECRET L R13,4(R13) L R14,12(R13) LM R0,R12,20(R13) BR 14 RECSAVE DS 18F GETFN MVC FILNAM(0),RDAT PICK UP FNAME GETFT MVC FILNAM+8(0),0(R5) PICK UP FTYPE PAD MVC 1(0,R9),0(R9) PAD OUT WITH SPACES LTORG DROP R11 DROP R12 DON'T NEED THEM ANYMORE END KERMIT