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