KERMIT TITLE 'Kermit -- MTS Version' * The Kermit protocol was designed at Columbia University in * in New York by Frank da Cruz, Bill Catchings and Daphne Tzoar. * * Copyright (c) 1983 Myrias Research Corporation * All rights reserved. * * This grotty piece of trash thrown together by Chris Thomson. SPACE 2 * This program is invoked by: * * $run kermit [scards=in] [sprint=out] [0=*net*] [par={s|m}] * * s=server mode; m=master mode * * If no par= is given, and 0 is assigned, then the default is * master mode; if 0 is not assigned, the default is server. * In master mode, commands are read from scards and output is * sent to sprint. If you want to set any non-default parameters * before entering server mode, use par=m. See set command for * parameters. TITLE 'Initialization' PRINT NOGEN KERMIT CSECT REQU TYPE=DEC SAVE (14,12),,* Standard linkage LR R12,R15 USING KERMIT,R12 LA R11,2048(,R12) LA R11,2048(,R11) USING KERMIT+4096,R11 LA R10,2048(,R11) LA R10,2048(,R10) USING KERMIT+8192,R10 LA R15,SAVEAREA ST R13,4(,R15) ST R15,8(,R13) LR R13,R15 LR R2,R1 Save parameter, if any MVI SERVER,1 Server if no unit 0 MVI NETDEV,X'FF' Assume no net device MVI FILETYPE,C'T' Default to filetype=text MVI EOLCHAR,13 Default to eolchar=13 (CR) MVI EOLCHAR2,13 XC NPAD,NPAD No outbound padding MVI PADCHAR,0 Pad character of NUL MVI DEBUG,0 Debugging output off LA R1,=C'-DEBUG(*L+1) ' But set up unit just in case CALL GETFD ST R0,DEBUNIT SR R0,R0 Get info about unit 0 CALL GDINFO LTR R15,R15 BNZ INIT30 MVI SERVER,0 CLI 13(R1),9 Error if not net BE INIT10 SPRINT ' Unit 0 must be a network device' B ERREXIT INIT10 L R3,36(,R1) FDname of device LH R4,0(,R3) Length of it S R4,=F'1' C R4,=F'31' BNH INIT20 SPRINT ' Unit 0 FDname too long' B ERREXIT INIT20 MVC NETDEV(32),=CL32' ' Copy device name for connect cmd EX R4,NDMVC SR R0,R0 Free gdinfo area CALL FREESPAC B INIT30 NDMVC MVC NETDEV(*-*),2(R3) INIT30 LTR R2,R2 BZ INIT60 No parameter L R2,0(,R2) LTR R2,R2 BZ INIT60 CLC 0(2,R2),=H'0' BE INIT60 CLC 0(2,R2),=H'1' Parameter must be 1 character BNE INIT50 CLI 2(R2),C'S' Parameter can override server/master BNE INIT40 default value MVI SERVER,1 B INIT60 INIT40 CLI 2(R2),C'M' BNE INIT50 MVI SERVER,0 B INIT60 INIT50 SERCOM ' Invalid par field' B ERREXIT INIT60 LA R1,PFXPAR Set prefix to Kermit-MTS> CALL CUINFO B MAINLOOP TITLE 'Main command loop' MAINLOOP CLI SERVER,0 Are we a server? BZ LOCCMD No -- read a local command B REMCMD Yes -- read a remote command SPACE 1 ABORT CLI NETDEV,X'FF' BE ABORT10 SPRINT ' Aborted -- try again' MVI PACKET,ASCB Send break packet MVI WPCKTNUM,0 LA R1,1 BAL R9,WRPACKET B MAINLOOP ABORT10 MVC PACKET(21),=C'EAborted -- try again' MVI WPCKTNUM,0 LA R1,21 BAL R9,TRETOA BAL R9,WRPACKET B MAINLOOP SPACE 1 ERRPCKT BAL R9,TRATOE MVC SCBUF(15),=C' Remote error: ' Use scards buffer S R1,=F'2' BL ERRP10 EX R1,ERRPMVC ERRP10 LA R1,16(,R1) STH R1,SCLEN CALL SPRINT,(SCBUF,SCLEN,SCMOD,SCLNUM) B MAINLOOP ERRPMVC MVC SCBUF+15(*-*),PACKET+1 SPACE 1 WRTFERR CLI NETDEV,X'FF' BE WRTFE10 SPRINT ' Bad return code writing to file' MVI PACKET,ASCB Send break packet MVI WPCKTNUM,0 LA R1,1 BAL R9,WRPACKET B MAINLOOP WRTFE10 MVC PACKET(32),=C'EBad return code writing to file' MVI WPCKTNUM,0 LA R1,32 BAL R9,TRETOA BAL R9,WRPACKET B MAINLOOP SPACE 1 PTOOLONG CLI NETDEV,X'FF' BE PTL10 SPRINT ' Packet too long -- aborting' MVI PACKET,ASCB Send break packet MVI WPCKTNUM,0 LA R1,1 BAL R9,WRPACKET B MAINLOOP PTL10 MVC PACKET(28),=C'EPacket too long -- aborting' MVI WPCKTNUM,0 LA R1,28 BAL R9,TRETOA BAL R9,WRPACKET B MAINLOOP SPACE 1 ERREXIT LA R15,4 B COMEXIT EXIT SR R15,R15 COMEXIT L R13,4(,R13) Standard return sequence L R14,12(,R13) LM R0,R12,20(R13) BR R14 TITLE 'Server command loop' REMCMD MVI WPCKTNUM,0 BAL R9,RDPACKET Get a packet -- this may take a while BNZ REMCMDE BAL R9,TRATOE CLI PACKET,C'S' Send-initiate BE GOTS CLI PACKET,C'R' Receive-initiate BE GOTR CLI PACKET,C'C' BE DOCMD CLI PACKET,C'G' BE GOTG MVC PACKET(38),=C'EUnsupported or invalid server request' LA R1,38 BAL R9,TRETOA BAL R9,WRPACKET B MAINLOOP REMCMDE MVI PACKET,ASCN LA R1,1 BAL R9,WRPACKET B MAINLOOP SPACE 1 GOTR LR R2,R1 Set up to merge with SEND LA R1,PACKET+1 S R2,=F'1' LA R3,0(R1,R2) MVI 0(R3),X'FF' BH SENDSRV *** cc set above *** MVC PACKET(37),=C'EMissing file spec in rcv-init packet' LA R1,37 BAL R9,TRETOA BAL R9,WRPACKET B MAINLOOP SPACE 1 DOCMD S R1,=F'1' Execute an MTS command ST R1,CMDLEN LA R1,PACKET+1 ST R1,CMDPTR LA R1,CMDPTR CALL CMD MVI PACKET,ASCY Send ack LA R1,1 BAL R9,WRPACKET B MAINLOOP SPACE 1 GOTG CLI PACKET+1,C'L' BE SLOGOUT CLI PACKET+1,C'F' BE SFINISH MVC PACKET(42),=C'EOnly F and L server generics supported' LA R1,42 BAL R9,TRETOA BAL R9,WRPACKET B MAINLOOP SPACE 1 SFINISH MVI PACKET,ASCY Send acknowledgement LA R1,1 BAL R9,WRPACKET B EXIT SPACE 1 SLOGOUT MVI PACKET,ASCY Send acknowledgement LA R1,1 BAL R9,WRPACKET CMD '$SIGNOFF $' DC H'0' TITLE 'Master command loop' LOCCMD CALL SCARDS,(SCBUF,SCLEN,SCMOD,SCLNUM) LA R1,SCBUF LH R2,SCLEN EX R2,CMDTR LA R3,0(R1,R2) MVI 0(R3),X'FF' Delimit the command for easy parsing BAL R9,SPNBL Span blanks on the front CLI 0(R1),C'$' Check for MTS command BNE CMD10 CMD (R1),(R2) Perform MTS command B MAINLOOP CMD10 LR R3,R1 BAL R9,BRKBL Break on a blank LR R4,R1 Length of word SR R4,R3 S R4,=F'1' (-1 for ex) BL MAINLOOP Line was all blank LA R5,CMDTAB Point at command table CMD20 C R4,4(,R5) Meet minimum length requirement? BL CMD30 No EX R4,CMDCLC Match prefix of command? BNE CMD30 No L R3,0(,R5) Yes -- branch to handler BR R3 CMD30 LA R5,CMDELEN(,R5) Next command table entry CLC 0(4,R5),=F'0' Error if end of table BNE CMD20 SPRINT ' Invalid command. Valid commands are:' SPRINT ' bye, connect, display, exit, finish, help, logout,' SPRINT ' receive, set, send, server, show, stop, and ?' B MAINLOOP CMDTR TR 0(*-*,R1),LCUC CMDCLC CLC 0(*-*,R3),8(R5) SPACE 1 SPNBL CLI 0(R1),C' ' Skip over blanks to end of line BNER R9 LA R1,1(,R1) S R2,=F'1' BH SPNBL BR R9 SPACE 1 BRKBL CLI 0(R1),C' ' Stop at a blank or end of line BER R9 LTR R2,R2 BZR R9 LA R1,1(,R1) S R2,=F'1' BH BRKBL BR R9 SPACE 1 BRKEQ CLI 0(R1),C'=' Stop at an = or end of line BER R9 LTR R2,R2 BZR R9 LA R1,1(,R1) S R2,=F'1' BH BRKEQ BR R9 SPACE 1 * First word is handler address * Second word is minimum abbreviation length minus one * Third part is string; must have at least one trailing blank * for the parsing code to work correctly CMDTAB DC A(BYE),F'0',CL16'BYE' DC A(CONNECT),F'0',CL16'CONNECT' DC A(SHOW),F'0',CL16'DISPLAY' DC A(EXIT),F'0',CL16'EXIT' DC A(FINISH),F'0',CL16'FINISH' DC A(HELP),F'0',CL16'HELP' DC A(LOGOUT),F'0',CL16'LOGOUT' DC A(RECEIVE),F'0',CL16'RECEIVE' DC A(SET),F'2',CL16'SET' DC A(SEND),F'2',CL16'SEND' DC A(ENSERV),F'2',CL16'SERVER' DC A(SHOW),F'1',CL16'SHOW' DC A(EXIT),F'1',CL16'STOP' DC A(HELP),F'0',CL16'?' DC A(0) CMDELEN EQU 24 TITLE 'Commands -- server, bye, logout, finish' ENSERV MVI SERVER,1 B MAINLOOP SPACE 1 BYE XC RETRYCNT,RETRYCNT BYEL L R1,RETRYCNT LA R1,1(,R1) ST R1,RETRYCNT C R1,MAXRETRY BH ABORT MVC PACKET(2),=C'GL' Send generic logout packet MVI WPCKTNUM,0 LA R1,2 BAL R9,TRETOA BAL R9,WRPACKET BAL R9,RDPACKET Read response BNZ BYEL BAL R9,TRATOE CLI PACKET,C'Y' BE EXIT Shut down if ack CLI PACKET,C'N' Loop if nak BE BYEL B ABORT Others are errors SPACE 1 LOGOUT XC RETRYCNT,RETRYCNT LOGOUTL L R1,RETRYCNT LA R1,1(,R1) ST R1,RETRYCNT C R1,MAXRETRY BH ABORT MVC PACKET(2),=C'GL' Send generic logout packet MVI WPCKTNUM,0 LA R1,2 BAL R9,TRETOA BAL R9,WRPACKET BAL R9,RDPACKET Read response BNZ LOGOUTL BAL R9,TRATOE CLI PACKET,C'Y' BE MAINLOOP Next command if ack CLI PACKET,C'N' BE LOGOUTL B ABORT SPACE 1 FINISH XC RETRYCNT,RETRYCNT FINISHL L R1,RETRYCNT LA R1,1(,R1) ST R1,RETRYCNT C R1,MAXRETRY BH ABORT MVC PACKET(2),=C'GF' Send generic finish packet LA R1,2 BAL R9,TRETOA BAL R9,WRPACKET BAL R9,RDPACKET Read response BNZ FINISHL BAL R9,TRATOE CLI PACKET,C'Y' BE MAINLOOP Next command if ack CLI PACKET,C'N' BE FINISHL B ABORT TITLE 'Commands -- help, connect, show' HELP SPRINT ' The following commands are supported:' SPRINT ' $... an MTS command' SPRINT ' bye log out remote and exit local kermit' SPRINT ' connect emulate terminal on remote system' SPRINT ' display display various set parameters' SPRINT ' exit exit local kermit; remote unaffected' SPRINT ' finish exit but don''t log out remote kermit' SPRINT ' help what you''re reading' SPRINT ' receive receive one or more files' SPRINT ' send send one or more files' SPRINT ' server make local kermit into a server' SPRINT ' set set various parameters' SPRINT ' show save as display' SPRINT ' stop same as exit' SPRINT ' ? same as help' SPRINT ' For more on parameters, enter set ?' B MAINLOOP SPACE 1 CONNECT CLI NETDEV,X'FF' Is there a network device? BNE CONN10 Yes SPRINT ' Unit 0 not assigned to network device' B MAINLOOP CONN10 SPRINT ' Calling net dsr; use @stop to return to kermit' LA R1,NETCMD CALL CMD B MAINLOOP SPACE 1 SHOW SPRINT ' The following parameter values are set:' MVC SCBUF(12),=C' filetype=' CLI FILETYPE,C'T' BNE SHOW10 MVC SCBUF+12(5),=C'text ' B SHOW20 SHOW10 MVC SCBUF+12(5),=C'saved' SHOW20 LA R1,17 STH R1,SCLEN CALL SPRINT,(SCBUF,SCLEN,SCMOD,SCLNUM) MVC SCBUF(13),=C' endofline=' SR R1,R1 IC R1,EOLCHAR CVD R1,WORK UNPK SCBUF+13(2),WORK(8) OI SCBUF+14,C'0' LA R1,15 STH R1,SCLEN CALL SPRINT,(SCBUF,SCLEN,SCMOD,SCLNUM) MVC SCBUF(9),=C' debug=' CLI DEBUG,0 BNE SHOW30 MVC SCBUF+9(3),=C'off' B SHOW40 SHOW30 MVC SCBUF+9(3),=C'on ' SHOW40 LA R1,12 STH R1,SCLEN CALL SPRINT,(SCBUF,SCLEN,SCMOD,SCLNUM) B MAINLOOP TITLE 'Commands -- set' SET BAL R9,SPNBL Extract parameter=value pair CLI 0(R1),C'?' BNE SET10 SPRINT ' Set parameters are:' SPRINT ' filetype set to text for normal, readable files,+ ' SPRINT ' or saved for unformatted byte streams' SPRINT ' that have originated on another system' SPRINT ' and contain embedded formatting data;' SPRINT ' default is text' SPRINT ' endofline set to decimal value of a control' SPRINT ' character to be used as end of line' SPRINT ' (packet) terminator in send operations;+ ' SPRINT ' default is 13 (CR), some systems want' SPRINT ' 10 (LF); must be 0-31' SPRINT ' debug on or off; puts all packets in -debug' B MAINLOOP SET10 LR R3,R1 BAL R9,BRKEQ LR R4,R1 Length of parameter SR R4,R3 S R4,=F'1' (-1 for ex) BL SETERR No operand CLI 0(R1),C'=' Must be an = BNE SETERR LA R1,1(,R1) S R2,=F'1' LA R5,SETTAB Point at parameter table SET20 C R4,4(,R5) Meet minimum length requirement? BL SET30 No EX R4,SETCLC Match prefix of parameter? BNE SET30 No L R3,0(,R5) Yes -- branch to handler BR R3 SET30 LA R5,SETELEN(,R5) Next parameter table entry CLC 0(4,R5),=F'0' Error if end of table BNE SET20 SETERR SPRINT ' Invalid set parameter. Valid parameters are:' SPRINT ' filetype=text, filetype=saved' SPRINT ' endofline=dd (dd=0-31)' SPRINT ' debug=on, debug=off' B MAINLOOP SETCLC CLC 0(*-*,R3),8(R5) SPACE 1 * Parameter table. Same format as command table. SETTAB DC A(SETFT),F'0',CL16'FILETYPE' DC A(SETEOL),F'0',CL16'ENDOFLINE' DC A(SETDEB),F'0',CL16'DEBUG' DC A(0) SETELEN EQU 24 SPACE 1 SETFT LTR R2,R2 Must be something there BNH SETERR CLI 0(R1),C'T' Accept anything that starts with BE SETFTOK t or s CLI 0(R1),C'S' BNE SETERR SETFTOK MVC FILETYPE(1),0(R1) BAL R9,BRKBL Might be more parameters to set BAL R9,SPNBL LTR R2,R2 BNH MAINLOOP B SET10 SPACE 1 SETEOL LTR R2,R2 Must be something there BNH SETERR SR R3,R3 Convert from decimal to binary SETEOL10 CLI 0(R1),C'0' the hard way BL SETERR CLI 0(R1),C'9' BH SETERR MH R3,=H'10' SR R4,R4 IC R4,0(R1) S R4,=A(C'0') AR R3,R4 C R3,=F'31' Maximum allowed is 31 BH SETERR LA R1,1(,R1) S R2,=F'1' BNH SETEOL20 CLI 0(R1),C' ' BNE SETEOL10 SETEOL20 STC R3,EOLCHAR BAL R9,BRKBL Might be more parameters to set BAL R9,SPNBL LTR R2,R2 BNH MAINLOOP B SET10 SPACE 1 SETDEB LTR R2,R2 Must be something there BNH SETERR CLC 0(2,R1),=C'ON' Accept anything that starts with BE SETDEB10 on or of CLC 0(2,R1),=C'OF' BNE SETERR MVI DEBUG,0 B SETDEB20 SETDEB10 MVI DEBUG,1 SETDEB20 BAL R9,BRKBL Might be more parameters to set BAL R9,SPNBL LTR R2,R2 BNH MAINLOOP B SET10 TITLE 'Commands -- send' SEND BAL R9,SPNBL SENDSRV LR R3,R1 Extract filespec BAL R9,BRKBL LR R4,R1 BAL R9,SPNBL LTR R2,R2 BNH SEND20 CLI SERVER,1 BE SEND10 SPRINT ' Send takes a single file spec argument' B MAINLOOP SEND10 MVC PACKET(37),=C'EExtra junk at end of rcv-init packet' MVI WPCKTNUM,0 LA R1,37 BAL R9,TRETOA BAL R9,WRPACKET B MAINLOOP SEND20 LR R1,R3 Point at filespec LR R2,R4 SR R2,R1 BAL R9,EXPFSPC Expand filespec CLC NFILES(4),=F'0' BH SEND40 CLI SERVER,1 BE SEND30 SPRINT ' File not found' B MAINLOOP SEND30 MVC PACKET(15),=C'EFile not found' MVI WPCKTNUM,0 LA R1,15 BAL R9,TRETOA BAL R9,WRPACKET B MAINLOOP SEND40 MVI WPCKTNUM,0 Reset output packet number XC RETRYCNT,RETRYCNT and retry counter SEND50 L R1,RETRYCNT LA R1,1(,R1) ST R1,RETRYCNT C R1,MAXRETRY BH ABORT MVI PACKET,ASCS Send-init packet MVI PACKET+1,94+32 My max packet length MVI PACKET+2,5+32 Time out in 5 seconds MVI PACKET+3,4+32 4 turnaround pad characters needed MVI PACKET+4,0+64 Use null for pad character MVI PACKET+5,13+32 End of line character (CR) MVI PACKET+6,35 Control character quote (#) MVI PACKET+7,ASCY I can do 8-bit quoting MVI PACKET+8,49 1-character checksum (1) MVI PACKET+9,126 Repeat prefix character (tilde) LA R1,10 BAL R9,WRPACKET BAL R9,RDPACKET BNZ SEND50 CLI PACKET,ASCN BE SEND50 CLI PACKET,ASCY BNE ABORT CLC RPCKTNUM(1),WPCKTNUM BNE SEND50 MVC MPLEN(4),=F'94' Set defaults MVC NPAD(4),=F'0' MVI PADCHAR,0 MVC EOLCHAR2(1),EOLCHAR MVI CTLQT,35 MVI BINQT,ASCN MVI RPTCHAR,32 LR R2,R1 S R2,=F'1' BNH SENDNXTF SR R1,R1 Copy his parameters IC R1,PACKET+1 S R1,=F'32' ST R1,MPLEN Maximum packet length S R2,=F'2' BNH SENDNXTF IC R1,PACKET+3 S R1,=F'32' ST R1,NPAD Number of pad characters S R2,=F'1' BNH SENDNXTF IC R1,PACKET+4 X R1,=F'64' STC R1,PADCHAR Pad character S R2,=F'1' BNH SENDNXTF IC R1,PACKET+5 S R1,=F'32' STC R1,EOLCHAR2 End of line character S R2,=F'1' BNH SENDNXTF MVC CTLQT(1),PACKET+6 Control character quote S R2,=F'1' BNH SENDNXTF MVC BINQT(1),PACKET+7 Binary (8-bit) quote character S R2,=F'2' BNH SENDNXTF MVC RPTCHAR(1),PACKET+9 Compression prefix character SENDNXTF L R1,NFILES Open next file S R1,=F'1' ST R1,NFILES BL SBREAK Sent all of them SLL R1,6 Point at FDname (64 characters) A R1,=A(FILES) MVC FILENAME(64),0(R1) Copy name for file header LA R1,FILENAME CALL GETFD LTR R15,R15 BZ SEND80 SEND60 CLI NETDEV,X'FF' BE SEND70 SPRINT ' Unable to open file' B SBREAK SEND70 MVC PACKET(20),=C'EUnable to open file' MVI WPCKTNUM,0 LA R1,20 BAL R9,TRETOA BAL R9,WRPACKET B MAINLOOP SEND80 ST R0,FDUB CALL GDINFO Open the file LTR R15,R15 BNZ SEND60 MVC WORK(1),13(R1) SR R0,R0 Free gdinfo block CALL FREESPAC CLI WORK,X'FF' Check for type=none BE SEND60 XC BUFFCNT,BUFFCNT File buffer is empty MVI EOFFLAG,0 Not at end of file XC RETRYCNT,RETRYCNT IC R1,WPCKTNUM LA R1,1(,R1) STC R1,WPCKTNUM NI WPCKTNUM,63 CLI NETDEV,X'FF' BE SENDFHDR MVC SCBUF(9),=C' Sending ' MVC SCBUF+9(64),FILENAME LA R2,73 SPRINT SCBUF,(R2) SENDFHDR L R1,RETRYCNT LA R1,1(,R1) ST R1,RETRYCNT C R1,MAXRETRY BH ABORT MVI PACKET,C'F' Send file header packet MVC PACKET+1(64),FILENAME LA R1,PACKET+64 Trim trailing blanks off name SEND90 CLI 0(R1),C' ' BNE SEND100 S R1,=F'1' B SEND90 SEND100 S R1,=A(PACKET) LA R1,1(,R1) BAL R9,TRETOA BAL R9,WRPACKET BAL R9,RDPACKET BNZ SENDFHDR CLI PACKET,ASCN BNE SEND110 IC R2,RPCKTNUM Nak for next packet is same as A R2,=F'63' ack for this packet STC R2,WORK NI WORK,63 CLC WORK(1),WPCKTNUM BNE SENDFHDR B SEND120 SEND110 CLI PACKET,ASCY BNE ABORT CLC WPCKTNUM(1),RPCKTNUM BNE SENDFHDR SEND120 XC RETRYCNT,RETRYCNT IC R1,WPCKTNUM LA R1,1(,R1) STC R1,WPCKTNUM NI WPCKTNUM,63 XC PCKTLEN,PCKTLEN SEND130 L R1,BUFFCNT Get next character from file LTR R1,R1 BNZ SEND160 CLI EOFFLAG,0 End of line; also end of file? BE SEND140 CLC PCKTLEN(4),=F'0' End of file; anything in packet? BE SENDEOF B SENDDATA SEND140 CALL READ,(BUFFER,BUFLEN,BUFMOD,BUFLNUM,FDUB) LTR R15,R15 BZ SEND150 MVI EOFFLAG,1 B SEND130 SEND150 LH R1,BUFLEN ST R1,BUFFCNT SEND160 LH R0,BUFLEN Point at next char in buffer SR R0,R1 A R0,=A(BUFFER) LR R4,R0 CLI RPTCHAR,32 Is compression allowed? BE SEND180 No IC R3,0(,R4) Tricky clcl to see how many of SLL R3,24 this character there are CLCL R0,R2 SR R0,R4 There are this many C R0,=F'4' BL SEND180 Not worth the bother C R0,=F'94' Can't have too many either BNH SEND170 LA R0,94 SEND170 L R1,BUFFCNT Consume this many characters SR R1,R0 ST R1,BUFFCNT L R1,PCKTLEN Put out prefix and count LA R2,PACKET+1(R1) MVC 0(1,R2),RPTCHAR A R0,=F'32' STC R0,1(,R2) LA R1,2(,R1) ST R1,PCKTLEN B SEND190 SEND180 L R1,BUFFCNT Consume one character S R1,=F'1' ST R1,BUFFCNT SEND190 MVC WORK(1),0(R4) Translate char if filetype=text CLI FILETYPE,C'T' BNE SEND200 TR WORK(1),ETOA B SEND210 No parity quoting needed SEND200 TM WORK,X'80' BZ SEND210 CLI BINQT,ASCN Is binary quoting allowed? BE SEND210 No -- send it the way it is L R1,PCKTLEN Put out 8-bit prefix LA R2,PACKET+1(R1) MVC 0(1,R2),BINQT LA R1,1(,R1) ST R1,PCKTLEN NI WORK,X'7F' SEND210 CLI WORK,127 See if control quoting needed BE SEND220 CLI WORK,31 BNH SEND220 CLC WORK(1),CTLQT BE SEND230 CLI BINQT,ASCN BE SEND215 CLC WORK(1),BINQT BE SEND230 SEND215 CLI RPTCHAR,32 BE SEND240 CLC WORK(1),RPTCHAR BNE SEND240 B SEND230 SEND220 XI WORK,64 Not a control char anymore SEND230 L R1,PCKTLEN Put out control prefix LA R2,PACKET+1(R1) MVC 0(1,R2),CTLQT LA R1,1(,R1) ST R1,PCKTLEN SEND240 L R1,PCKTLEN Finally, put in the character LA R2,PACKET+1(R1) MVC 0(1,R2),WORK LA R1,1(,R1) ST R1,PCKTLEN CLC BUFFCNT(4),=F'0' One last thing -- put crlf at eol BNE SEND250 CLI FILETYPE,C'T' if filetype=text BNE SEND250 L R1,PCKTLEN LA R2,PACKET+1(R1) MVC 0(1,R2),CTLQT MVI 1(R2),77 MVC 2(1,R2),CTLQT MVI 3(R2),74 LA R1,4(,R1) ST R1,PCKTLEN SEND250 L R1,PCKTLEN Have we about filled a packet? A R1,=F'10' C R1,MPLEN BL SEND130 No, loop SENDDATA L R1,RETRYCNT LA R1,1(,R1) ST R1,RETRYCNT C R1,MAXRETRY BH ABORT MVI PACKET,ASCD Send data packet L R1,PCKTLEN A R1,=F'1' BAL R9,WRPACKET BAL R9,RDPACKET BNZ SENDDATA CLI PACKET,ASCN BNE SEND260 IC R2,RPCKTNUM Nak for next packet is same as A R2,=F'63' ack for this packet STC R2,WORK NI WORK,63 CLC WORK(1),WPCKTNUM BNE SENDDATA B SEND120 SEND260 CLI PACKET,ASCY BNE ABORT CLC WPCKTNUM(1),RPCKTNUM BNE SENDDATA XC PCKTLEN,PCKTLEN Packet now empty B SEND120 Loop through whole file SENDEOF XC RETRYCNT,RETRYCNT SENDEOFL L R1,RETRYCNT LA R1,1(,R1) ST R1,RETRYCNT C R1,MAXRETRY BH ABORT MVI PACKET,ASCZ Send end of file packet LA R1,1 BAL R9,WRPACKET BAL R9,RDPACKET BNZ SENDEOFL CLI PACKET,ASCN BNE SEND270 IC R2,RPCKTNUM Nak for next packet is same as A R2,=F'63' ack for this packet STC R2,WORK NI WORK,63 CLC WORK(1),WPCKTNUM BNE SENDEOFL B SEND280 SEND270 CLI PACKET,ASCY BNE ABORT CLC WPCKTNUM(1),RPCKTNUM BNE SENDEOFL SEND280 L R0,FDUB Close the file CALL FREEFD B SENDNXTF Send next file, if any SBREAK XC RETRYCNT,RETRYCNT IC R1,WPCKTNUM LA R1,1(,R1) STC R1,WPCKTNUM NI WPCKTNUM,63 SBREAKL L R1,RETRYCNT LA R1,1(,R1) ST R1,RETRYCNT C R1,MAXRETRY BH ABORT MVI PACKET,ASCB Send break (EOT) packet LA R1,1 BAL R9,WRPACKET BAL R9,RDPACKET BNZ SBREAKL CLI PACKET,ASCN BNE SEND290 IC R2,RPCKTNUM Nak for next packet is same as A R2,=F'63' ack for this packet STC R2,WORK NI WORK,63 CLC WORK(1),WPCKTNUM BNE SBREAKL B MAINLOOP SEND290 CLI PACKET,ASCY BNE ABORT CLC WPCKTNUM(1),RPCKTNUM BNE SBREAKL B MAINLOOP TITLE 'Commands -- receive' RECEIVE BAL R9,SPNBL Extract file spec, if any LR R3,R1 BAL R9,BRKBL CR R1,R3 BE REC10 No file spec LR R4,R1 SR R4,R3 S R4,=F'1' Copy file spec into packet EX R4,RECFSMVC MVI PACKET,C'R' MVI WPCKTNUM,0 LA R1,2(,R4) BAL R9,TRETOA BAL R9,WRPACKET Send rcv-init packet REC10 XC RETRYCNT,RETRYCNT REC20 L R1,RETRYCNT LA R1,1(,R1) ST R1,RETRYCNT C R1,MAXRETRY BH ABORT BAL R9,RDPACKET Wait for send-init packet BNE REC20 CLI PACKET,ASCN BE REC20 CLI PACKET,ASCS BNE ABORT XC RETRYCNT,RETRYCNT B REC30 RECFSMVC MVC PACKET+1(*-*),0(R3) GOTS BAL R9,TRETOA XC RETRYCNT,RETRYCNT REC30 L R1,RETRYCNT LA R1,1(,R1) ST R1,RETRYCNT C R1,MAXRETRY BH ABORT MVC MPLEN(4),=F'94' Set defaults MVC NPAD(4),=F'0' MVI PADCHAR,0 MVC EOLCHAR2(1),EOLCHAR MVI CTLQT,35 MVI BINQT,ASCN MVI RPTCHAR,32 LR R2,R1 S R2,=F'1' BNH REC50 SR R1,R1 Copy his parameters IC R1,PACKET+1 S R1,=F'32' ST R1,MPLEN Maximum packet length S R2,=F'2' BNH REC50 IC R1,PACKET+3 S R1,=F'32' ST R1,NPAD Number of pad characters S R2,=F'1' BNH REC50 IC R1,PACKET+4 X R1,=F'64' STC R1,PADCHAR Pad character S R2,=F'1' BNH REC50 IC R1,PACKET+5 S R1,=F'32' STC R1,EOLCHAR2 End of line character S R2,=F'1' BNH REC50 MVC CTLQT(1),PACKET+6 Control character quote S R2,=F'1' BNH REC50 MVC BINQT(1),PACKET+7 Binary (8-bit) quote character CLI BINQT,ASCY BNE REC40 MVI BINQT,38 Use & if he said Y REC40 S R2,=F'2' BNH REC50 MVC RPTCHAR(1),PACKET+9 Compression prefix character REC50 MVI PACKET,ASCY Send back ack with parameters L R1,MPLEN A R1,=F'32' STC R1,PACKET+1 Use his max packet length MVI PACKET+2,5+32 Time out in 5 seconds MVI PACKET+3,4+32 4 turnaround pad characters needed MVI PACKET+4,0+64 Use null for pad character MVI PACKET+5,13+32 End of line character I want (CR) MVC PACKET+6(1),CTLQT Control character quote MVC PACKET+7(1),BINQT 8-bit quote MVI PACKET+8,49 1-character checksum (1) MVC PACKET+9(1),RPTCHAR Repeat prefix character MVI WPCKTNUM,0 LA R1,10 BAL R9,WRPACKET BAL R9,RDPACKET Read for first F packet BNZ REC30 CLI PACKET,ASCN BE REC30 CLI PACKET,ASCS BE REC30 CLI PACKET,ASCF BNE ABORT REC60 MVC FILENAME(64),=CL64' ' Extract file name from packet BAL R9,TRATOE S R1,=F'2' BH REC70 MVC PACKET(18),=C'EMissing file name' MVI WPCKTNUM,0 LA R1,18 BAL R9,WRPACKET B ABORT RECFMVC MVC FILENAME(*-*),PACKET+1 REC70 EX R1,RECFMVC REC80 LA R1,FILENAME CALL GETFD Attempt to open the file LTR R15,R15 BZ REC110 REC90 CLI NETDEV,X'FF' BE REC100 SPRINT ' Unable to open file' B ABORT REC100 MVC PACKET(20),=C'EUnable to open file' MVI WPCKTNUM,0 LA R1,20 BAL R9,TRETOA BAL R9,WRPACKET B MAINLOOP REC110 ST R0,FDUB CALL GDINFO Open the file LTR R15,R15 BNZ REC90 MVC WORK(1),13(R1) SR R0,R0 Free gdinfo block CALL FREESPAC CLI WORK,X'FF' Check for type=none BNE REC120 CALL CREATE,(FILENAME,CRESIZE,CREVOL,CRETYPE) Try to create LTR R15,R15 the file BNZ REC90 Too bad B REC80 Try the open again REC120 L R0,FDUB Empty the file CALL EMPTY XC BUFLEN,BUFLEN MVI CRFLAG,0 IC R1,WPCKTNUM LA R1,1(,R1) STC R1,WPCKTNUM NI WPCKTNUM,63 XC RETRYCNT,RETRYCNT CLI NETDEV,X'FF' BE REC130 MVC SCBUF(11),=C' Receiving ' MVC SCBUF+11(64),FILENAME LA R2,75 SPRINT SCBUF,(R2) REC130 L R1,RETRYCNT LA R1,1(,R1) ST R1,RETRYCNT C R1,MAXRETRY BH ABORT MVI PACKET,ASCY LA R1,1 BAL R9,WRPACKET Ack the F packet BAL R9,RDPACKET BNZ REC130 CLI PACKET,ASCN BE REC130 CLC WPCKTNUM(1),RPCKTNUM Ack again if F again BE REC130 RECDATA CLI PACKET,ASCD Expecting D or Z packet BE REC140 CLI PACKET,ASCZ BE RECEOF B ABORT Sequence error REC140 LR R2,R1 Length of packet S R2,=F'1' Account for D at front LA R3,PACKET+1 REC150 LTR R2,R2 Anything left in packet? BNH REC290 No MVC WORK(1),0(R3) Copy char with/out parity MVC WORK+1(1),0(R3) NI WORK+1,X'7F' LA R4,1 Default repeat count CLI RPTCHAR,32 Compression allowed? BE REC160 No CLC WORK+1(1),RPTCHAR Repetition prefix? BNE REC160 No IC R4,1(,R3) Get repeat count N R4,=F'127' S R4,=F'32' S R2,=F'2' BNH ABORT LA R3,2(,R3) MVC WORK(1),0(R3) MVC WORK+1(1),0(R3) NI WORK+1,X'7F' REC160 SR R5,R5 Default high-order bit value CLI BINQT,ASCN 8-bit quoting enabled? BE REC170 No CLC WORK+1(1),BINQT BNE REC170 LA R5,128 Turn on high bit later S R2,=F'1' BNH ABORT LA R3,1(,R3) MVC WORK(1),0(R3) MVC WORK+1(1),0(R3) NI WORK+1,X'7F' REC170 CLC WORK+1(1),CTLQT Is it a control quote? BNE REC210 No MVC WORK(1),1(R3) MVC WORK+1(1),1(R3) NI WORK+1,X'7F' CLC WORK+1(1),CTLQT May be quoting a literal BE REC200 CLI RPTCHAR,32 BE REC180 CLC WORK+1(1),RPTCHAR BE REC200 REC180 CLI BINQT,ASCN BE REC190 CLC WORK+1(1),BINQT BE REC200 * Will not get here if control quote is followed by * quote with high order bit on (eg X'23A3'). REC190 XI WORK,64 Make it into a control char REC200 S R2,=F'1' BNH ABORT LA R3,1(,R3) REC210 SR R6,R6 IC R6,WORK Diddle with high bit CLI BINQT,ASCN Straight through if no bin quote BE REC215 N R6,=F'127' Otherwise 0 if no quote seen OR R6,R5 or 1 if quote seen REC215 CLI FILETYPE,C'T' Translate to ebcdic if filetype=text BNE REC220 IC R6,ATOE(R6) REC220 STC R6,WORK WORK has char, R4 has count LA R3,1(,R3) Account for the character S R2,=F'1' BL ABORT CLI FILETYPE,C'T' Look for CRLF in text files BNE REC260 CLI WORK,13 Is this a CR? BNE REC230 No C R4,=F'1' Better not be repeated BNE ABORT MVI CRFLAG,1 Set flag to say we've seen CR B REC150 REC230 CLI WORK,X'25' Is this a LF? BNE REC250 C R4,=F'1' Better not be repeated BNE ABORT CLI CRFLAG,1 Was last char a CR? BNE ABORT Don't like LF's without CR's LH R1,BUFLEN LTR R1,R1 Replace zero-length lines with blank BH REC240 LA R1,1 STH R1,BUFLEN L R1,=A(BUFFER) MVI 0(R1),C' ' REC240 CALL WRITE,(BUFFER,BUFLEN,BUFMOD,BUFLNUM,FDUB) LTR R15,R15 BNE WRTFERR Error writing to file XC BUFLEN,BUFLEN MVI CRFLAG,0 B REC150 REC250 CLI CRFLAG,0 Don't like CR's without LF's BNE ABORT REC260 LH R5,BUFLEN Point into buffer LR R6,R5 A R6,=A(BUFFER) REC270 MVC 0(1,R6),WORK Copy character to buffer LA R6,1(,R6) LA R5,1(,R5) C R5,=F'32767' Don't overflow buffer BL REC280 STH R5,BUFLEN CALL WRITE,(BUFFER,BUFLEN,BUFMOD,BUFLNUM,FDUB) LTR R15,R15 BNE WRTFERR Error writing to file SR R5,R5 L R6,=A(BUFFER) REC280 BCT R4,REC270 Repeat as necessary STH R5,BUFLEN New buffer length B REC150 Next character from packet REC290 IC R1,WPCKTNUM Bump write packet number LA R1,1(,R1) STC R1,WPCKTNUM NI WPCKTNUM,63 XC RETRYCNT,RETRYCNT REC300 L R1,RETRYCNT LA R1,1(,R1) ST R1,RETRYCNT C R1,MAXRETRY BH ABORT MVI PACKET,ASCY LA R1,1 BAL R9,WRPACKET Ack the D packet BAL R9,RDPACKET BNZ REC300 CLI PACKET,ASCN BE REC300 CLC WPCKTNUM(1),RPCKTNUM Ack again if last packet again BE REC300 B RECDATA Loop until Z packet RECEOF CLC BUFLEN(2),=H'0' Write out contents of buffer, if any BE REC310 CALL WRITE,(BUFFER,BUFLEN,BUFMOD,BUFLNUM,FDUB) LTR R15,R15 BNZ WRTFERR REC310 L R0,FDUB Close the file CALL FREEFD IC R1,WPCKTNUM Bump write packet number LA R1,1(,R1) STC R1,WPCKTNUM NI WPCKTNUM,63 XC RETRYCNT,RETRYCNT REC320 L R1,RETRYCNT LA R1,1(,R1) ST R1,RETRYCNT C R1,MAXRETRY BH ABORT MVI PACKET,ASCY LA R1,1 BAL R9,WRPACKET Ack the Z packet BAL R9,RDPACKET BNZ REC320 CLI PACKET,ASCN BE REC320 CLC WPCKTNUM(1),RPCKTNUM Ack again if last packete again BE REC320 CLI PACKET,ASCF Expecting F or B packet BE REC60 Process next file CLI PACKET,ASCB BNE ABORT IC R1,WPCKTNUM Bump write packet number LA R1,1(,R1) STC R1,WPCKTNUM NI WPCKTNUM,63 MVI PACKET,ASCY LA R1,1 BAL R9,WRPACKET Ack the B packet B MAINLOOP All done the receive TITLE 'WRPACKET -- write out a packet' WRPACKET LA R2,PACKET2 Build output packet here L R3,NPAD Put pads in first LTR R3,R3 BZ WRP20 WRP10 MVC 0(1,R2),PADCHAR LA R2,1(,R2) BCT R3,WRP10 WRP20 MVI 0(R2),1 SOH character SR R4,R4 Checksum LA R3,34(,R1) Length byte (R1+2+32) STC R3,1(,R2) AR R4,R3 IC R3,WPCKTNUM Sequence id LA R3,32(,R3) STC R3,2(,R2) AR R4,R3 LA R2,3(,R2) LA R5,PACKET Copy the packet proper WRP30 MVC 0(1,R2),0(R5) IC R3,0(,R5) AR R4,R3 LA R2,1(,R2) LA R5,1(,R5) BCT R1,WRP30 N R4,=F'255' Crunch checksum to 6 bits LR R3,R4 SRL R3,6 AR R4,R3 N R4,=F'63' A R4,=F'32' STC R4,0(,R2) MVC 1(1,R2),EOLCHAR2 Line terminator LA R2,2(,R2) LA R1,PACKET2 Length of finished packet SR R2,R1 CLI SERVER,1 Select unit based on server flag BE WRP40 Server always uses sprint, CLI NETDEV,X'FF' non-server uses 0 if assigned, BE WRP40 and sprint otherwise MVC RWPKUNIT(4),=F'0' B WRP50 WRP40 MVC RWPKUNIT(8),=C'SPRINT ' WRP50 STH R2,RWPKLEN CALL WRITE,(PACKET2,RWPKLEN,RWPKMOD,RWPKLNUM,RWPKUNIT) CLI DEBUG,0 BER R9 LA R2,1(,R2) STH R2,DEBLEN CALL WRITE,(DEBPK2,DEBLEN,DEBMOD,DEBLNUM,DEBUNIT) BR R9 TITLE 'RDPACKET -- read a packet' RDPACKET CLI SERVER,1 Select unit based on server flag BE RDP10 Server always uses scards, CLI NETDEV,X'FF' non-server uses 0 if assigned, BE RDP10 and scards otherwise MVC RWPKUNIT(4),=F'0' B RDP20 RDP10 MVC RWPKUNIT(8),=C'SCARDS ' RDP20 CALL READ,(PACKET3,RWPKLEN,RWPKMOD,RWPKLNUM,RWPKUNIT) LH R1,RWPKLEN * *#### Merit READ@BIN returns data in EBCDIC so restore to ASCII * L R4,=V(EBCMASC) STEP#1 EX R1,TREBMASC * CLI DEBUG,0 BE RDP30 LA R2,1(,R1) STH R2,DEBLEN CALL WRITE,(DEBPK3,DEBLEN,DEBMOD,DEBLNUM,DEBUNIT) LH R1,RWPKLEN RDP30 LTR R1,R1 BNH RDPFAIL C R1,=F'120' Generous overlength check BH PTOOLONG MVI WORK+1,X'7F' Mask to turn off parity, as nec CLI FILETYPE,C'T' BE RDP40 CLI BINQT,ASCN BNE RDP40 MVI WORK+1,X'FF' RDP40 LA R2,PACKET3 RDP50 MVC WORK(1),0(R2) NC WORK(1),WORK+1 CLI WORK,1 Look for soh BE RDP60 LA R2,1(,R2) BCT R1,RDP50 B RDPFAIL RDP60 LA R2,1(,R2) S R1,=F'1' BNH RDPFAIL MVC WORK(1),0(R2) NC WORK(1),WORK+1 SR R3,R3 Length byte IC R3,WORK LR R4,R3 This will be checksum S R3,=F'34' BNH RDPFAIL ST R3,PCKTLEN Save packet length LA R2,1(,R2) S R1,=F'1' BNH RDPFAIL MVC WORK(1),0(R2) NC WORK(1),WORK+1 SR R5,R5 Packet sequence number IC R5,WORK AR R4,R5 S R5,=F'32' STC R5,RPCKTNUM LA R2,1(,R2) S R1,=F'1' BNH RDPFAIL LA R6,PACKET RDP70 MVC WORK(1),0(R2) Copy the packet proper NC WORK(1),WORK+1 IC R5,WORK AR R4,R5 STC R5,0(,R6) LA R6,1(,R6) LA R2,1(,R2) S R1,=F'1' BNH RDPFAIL BCT R3,RDP70 MVC WORK(1),0(R2) Check the checksum NC WORK(1),WORK+1 IC R5,WORK S R5,=F'32' N R4,=F'255' LR R6,R4 SRL R6,6 AR R4,R6 N R4,=F'63' CR R4,R5 BNE RDPFAIL L R1,PCKTLEN Return with CC Z and len in R1 CLI PACKET,ASCE Is it an error packet? BE ERRPCKT Boom SR R0,R0 BR R9 RDPFAIL SR R1,R1 Return with CC NZ LTR R11,R11 BR R9 TITLE 'Translation from/to ascii/ebcdic' TRETOA S R1,=F'1' BL TRETOA10 EX R1,TRETOATR TRETOA10 A R1,=F'1' BR R9 TRETOATR TR PACKET(*-*),ETOA SPACE 1 TRATOE S R1,=F'1' BL TRATOE10 EX R1,TRATOETR TRATOE10 A R1,=F'1' BR R9 TRATOETR TR PACKET(*-*),ATOE SPACE 1 TREBMASC TR PACKET3(*-*),0(R4) TITLE 'Routine to expand a file spec' EXPFSPC XC NFILES,NFILES Init number of files found MVC FILESPEC(64),=CL64' ' Copy the file spec S R2,=F'1' BLR R9 C R2,=F'59' BH EXPFERR EX R2,EXPFMVC A R2,=F'1' TR FILESPEC(64),LCUC CALL GUINFO,(TWO,MYUID) Determine current signon userid CLI FILESPEC,C'*' BNE EXPF10 MVC USERID(4),=C'*SYS' B EXPF60 EXPFMVC MVC FILESPEC(*-*),0(R1) EXPF10 CLI FILESPEC,C'-' BNE EXPF20 MVC USERID(4),=C'*TMP' B EXPF60 EXPF20 LA R1,FILESPEC Copy userid if any LA R2,4 MVC USERID(4),=C'$.$.' Userid pad characters EXPF30 CLI 0(R1),C':' BE EXPF40 MVC 0(1,R3),0(R1) LA R1,1(,R1) LA R3,1(,R3) BCT R2,EXPF30 CLI 0(R1),C':' If no colon here, no userid given BNE EXPF50 EXPF40 MVC FILESPEC(60),1(R1) Crunch out userid B EXPF60 EXPF50 MVC USERID(4),MYUID Default is current signonid EXPF60 XC GFINFR(24),GFINFR EXPF70 CALL GFINFO,(USERID,GFINFR,THREE,GFINFZ,GFINFZ,GFINFZ),VL LTR R15,R15 BNZR R9 No more files MVC FILENAME(64),=CL64' ' CLC USERID(4),MYUID Gfinfo includes userid only if it's BE EXPF80 not for this task (sweet, eh) CLC USERID(4),=C'*SYS' BE EXPF80 CLC USERID(4),=C'*TMP' BE EXPF80 MVC FILENAME(4),GFINFR MVI FILENAME+4,C':' MVC FILENAME+5(16),GFINFR+4 LA R1,FILENAME+5 B EXPF90 EXPF80 MVC FILENAME(20),GFINFR LA R1,FILENAME * Allow single ? in file spec -- matches any substring EXPF90 LA R2,FILESPEC SR R3,R3 No ? yet SR R4,R4 EXPF100 CLI 0(R1),C' ' End of filename? BNE EXPF110 No CLI 0(R2),C' ' End of file spec? BNE EXPF70 No -- doesn't match L R1,NFILES Found a matching file name LR R2,R1 SLL R2,6 A R2,=A(FILES) MVC 0(64,R2),FILENAME LA R1,1(,R1) C R1,=F'64' Check for too many BH EXPFERR ST R1,NFILES B EXPF70 Look for more EXPF110 CLC 0(1,R1),0(R2) Characters match? BNE EXPF120 No LA R1,1(,R1) Yes -- move along LA R2,1(,R2) B EXPF100 Loop EXPF120 CLI 0(R2),C'?' ? in file spec? BNE EXPF130 LTR R3,R3 Seen one before? BNZ EXPFERR Yes -- error LA R2,1(,R2) Point past ? LR R3,R2 and save this address LA R4,1(,R1) This is where to continue after fail B EXPF100 Continue matching EXPF130 LTR R3,R3 Mismatch -- have we seen a ? BZ EXPF70 No -- names can't match LR R2,R3 Lengthen string matched by ? LR R1,R4 LA R4,1(,R1) B EXPF100 and try again SPACE 1 EXPFERR CLI NETDEV,X'FF' BE EXPF140 SPRINT ' Error expanding file spec' MVI PACKET,ASCB Send break packet MVI WPCKTNUM,0 LA R1,1 BAL R9,WRPACKET B MAINLOOP EXPF140 MVC PACKET(26),=C'EError expanding file spec' MVI WPCKTNUM,0 LA R1,26 BAL R9,TRETOA BAL R9,WRPACKET B MAINLOOP TITLE 'Constants and variable storage' SAVEAREA DS 18F TWO DC F'2' THREE DC F'3' PFXPAR DC A(PFXITEM,PFXDATA) PFXITEM DC CL8'PFXSTR ' PFXDATA DC F'19',F'11',CL11'Kermit-MTS>' WORK DS D NETCMD DC A(*+12),A(*+4),F'37',C'$NET ' NETDEV DS CL32 SERVER DS X FILETYPE DS X DEBUG DS X RETRYCNT DS F MAXRETRY DC F'10' CMDPTR DS A DC A(CMDLEN) MUST FOLLOW CMDPTR CMDLEN DS F SCBUF DS CL256 SCLEN DC H'0',H'255',H'0' SCMOD DC A(X'08000000') Maxlen SCLNUM DS F NFILES DS F FILENAME DS CL64 FILESPEC DS CL64 USERID DS CL4 MYUID DS CL4 DS 0F CRESIZE DC H'0',H'1' CREVOL DC XL6'00' CRETYPE DC F'256' RPCKTNUM DS X WPCKTNUM DS X PCKTLEN DS F PACKET DS CL150 DEBPK2 DC X'E2' MUST PRECEED PACKET2 PACKET2 DS CL150 DEBPK3 DC X'D9' MUST PRECEED PACKET3 PACKET3 DS CL150 RWPKLEN DC H'0',H'150',H'0' RWPKMOD DC A(X'08000008') Maxlen, binary RWPKLNUM DS F RWPKUNIT DS CL8 DEBLEN DS H DEBMOD DC F'0' DEBLNUM DC F'0' DEBUNIT DS A MPLEN DS F NPAD DS F PADCHAR DS X EOLCHAR DS X What user wants me to send EOLCHAR2 DS X What other kermit wants me to send CTLQT DS X BINQT DS X RPTCHAR DS X FDUB DS A EOFFLAG DS X CRFLAG DS X BUFFCNT DS F BUFLEN DS H BUFMOD DC A(X'40000000') BUFLNUM DS F GFINFZ DC F'0' GFINFR DS 6F LTORG SPACE 1 LCUC DC X'000102030405060708090A0B0C0D0E0F' DC X'101112131415161718191A1B1C1D1E1F' DC X'202122232425262728292A2B2C2D2E2F' DC X'303132333435363738393A3B3C3D3E3F' DC X'404142434445464748494A4B4C4D4E4F' DC X'505152535455565758595A5B5C5D5E5F' DC X'606162636465666768696A6B6C6D6E6F' DC X'707172737475767778797A7B7C7D7E7F' DC X'80C1C2C3C4C5C6C7C8C98A8B8C8D8E8F' DC X'90D1D2D3D4D5D6D7D8D99A9B9C9D9E9F' DC X'A0A1E2E3E4E5E6E7E8E9AAABACADAEAF' DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF' SPACE 1 ATOE DC X'00010203372D2E2F1605250B0C0D0E0F' Use AD/BD for sq br DC X'101112133C3D322618193F271C1D1E1F' Use 8B/9B for braces DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' Use 4F for stick DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' Use E0 for backslash DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' Use 5F for tilde DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD716D' Use 71 for circumflx DC X'79818283848586878889919293949596' Use 79 for grave DC X'979899A2A3A4A5A6A7A8A98B4F9B5F07' NOTE: This mapping DC X'00000000000000000000000000000000' is not the DC X'00000000000000000000000000000000' same as in the DC X'00000000000000000000000000000000' kermit manual. DC X'00000000000000000000000000000000' DC X'00000000000000000000000000000000' DC X'00000000000000000000000000000000' DC X'00000000000000000000000000000000' DC X'00000000000000000000000000000000' SPACE 1 ETOA DC X'000102030009007F0000000B0C0D0E0F' Use AD/BD for sq br DC X'1011121300000800181900001C1D1E1F' Use 8B/9B for braces DC X'00000000000A171B0000000000050607' Use 4F for stick DC X'0000160000000004000000001415001A' Use E0 for backslash DC X'20000000000000000000002E3C282B7C' Use 5F for tilde DC X'2600000000000000000021242A293B7E' Use 71 for circumflx DC X'2D2F00000000000000007C2C255F3E3F' Use 79 for grave DC X'005E00000000000000603A2340273D22' Also use: DC X'00616263646566676869007B00000000' C0/D0 for braces DC X'006A6B6C6D6E6F707172007D00000000' A1 for tilde DC X'007E737475767778797A0000005B0000' NOTE: This mapping DC X'000000000000000000000000005D0000' is not the DC X'7B414243444546474849000000000000' same as in the DC X'7D4A4B4C4D4E4F505152000000000000' kermit manual. DC X'5C00535455565758595A000000000000' DC X'303132333435363738397C0000000000' SPACE 1 FILES DS 64CL64 BUFFER DS 32768X SPACE 1 ASCB EQU 66 ASCD EQU 68 ASCE EQU 69 ASCF EQU 70 ASCN EQU 78 ASCS EQU 83 ASCY EQU 89 ASCZ EQU 90 END KERMIT