.title	KRTXMO	XMODEM, SEND command interface
	.ident	"V04.64"

; /E64/	07-Apr-96  John Santos
;
;	Conditionalize for RSTS.  Make c$send work, and remove XMODEM, which
;	I currently have no way of testing, and which has lots of RT11
;	calls built into it.
;	Check for errors after calling fparse.  (This only occurs in code
;	that is conditionalized for RT11, but I put it in so we don't
;	forget to do this if/when RSTS ever supports xmodem.)

; /63/	29-Jan-96  Billy Youdelman
;
;	disallow sends from TT (not supported, makes Kermit hang)..

; /62/	27-Jul-93  Billy Youdelman  V03.62
;
;	move command interface here from KRTCM1

; /BBS/	 1-Dec-91  Billy Youdelman  V03.61
;
; This module uses xmodem written by Chuck Sadoian, Dinuba, CA

; Xmodem here supports either checksum or CRC error detection, however it
; only does so one file at a time, using 128 byte blocks, under TSX-Plus.
; Transmission is presently only on the controlling terminal (this Kermit
; must be the remote system) and is also SEND-only from here to the other
; system, because the TSX-Plus terminal handler does not pass nulls (zero
; bytes) to a running program.
;
; The Xmodem protocol requires an 8-bit path.  If this isn't the system's
; default, you must from KMON issue the command SET TT 8BIT,BITS=8 before
; running Kermit.  "BITS=8" is a hardware parameter and must be done on a
; primary line only.  Setting it on a subprocess may write garbage in the
; line_parameters word, rendering the line useless.
;
; Xmodem doesn't work under RT-11 because RT strips all terminal I/O data
; of the high order (parity) bit, thus preventing an 8-bit data path from
; being used.


	.include "IN:KRTMAC.MAC"
	.iif ndf  KRTINC  .error	<; .include for IN:KRTMAC.MAC failed>
	.include "IN:KRTDEF.MAC"
	.iif ndf  MSG$DA  .error	<; .include for IN:KRTDEF.MAC failed>

	.mcall	.CMKT	,.MRKT	,.PURGE	,.SCCA
	.mcall	.READW	,.TTINR	,.TTYOUT,.TWAIT


	.macro	beep2
	wrtall	#$beep2			; make the terminal beep twice
	.endm	beep2


	.sbttl	Local data

	ACK	= 6			; acknowledge packet (ok)
	CAN	= 30			; cancel transfer
	CRC	= 1			; bit mask CRC enabled
	EOT	= 4			; end of transmission
	NAK	= 25			; negative acknowledge (not ok)
	NKWAIT	= 13.			; initial wait for first NAK in secs

	.psect	xmodat	,rw,d,lcl,rel,con
.if df	RT11				; /E64/
aflag:	.word	0			; abort flag
blkcnt:	.word	0			; for .readw, block just read
block:	.word	0			; file size in RT-11 blocks
bytcnt:	.word	0			; number of bytes in input buffer
chksum:	.word	0			; checksum
hieff:	.byte	0 ,120			; high efficiency terminal mode emt
marea:	.word	0 ,0 ,0 ,0		; .mrkt work area
mtime:	.word	0 ,0			; nkwait in ticks lives here
nosingle:.byte	0 ,152
	.word	'T&137,0		; turn off single char mode
onewide:.byte	0 ,152
	.word	'Q&137,1		; /62/ activate on field width of 1
point:	.word	0			; pointer to read buffer
rbuff:	.word	0			; input file buffer pointer
single:	.byte	0 ,152
	.word	'S&137,0		; turn on single char mode
sizbuf:	.byte	0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ; ascii'd size in xmodem blocks
tflag:	.word	0			; time-out flag
ttctlc:	.word	0 ,0 ,0			; for .scca
wtime:	.word	0 ,6			; 1/10 second (slightly more @ 50Hz)
xblock:	.word	0 ,0			; file size in xmodem blocks
xmosts:	.word	0			; status word
xrecno:	.word	0			; record number for packets
xtime:	.word	0 ,30.			; wait 0.5sec when finished or abort
.endc	;RT11				; /E64/

	.psect	$pdata			; /63/ consolidate here..
$beep2:	.byte	bell ,bell ,0		; two bells
sen.10:	.asciz	<bell>"Send completed"	; /62/
sen.11:	.asciz	<bell>"Send failed"
sen.12:	.asciz	'Processing file name "'
sen.13:	.asciz	'"'
.if df	RT11				; /E64/
xmo.01:	.asciz	"File open: "		; tell user about the file
xmo.02:	.asciz	"["			; size in RT-11 blocks goes here
xmo.03:	.asciz	"], "			; format the display
xmo.04:	.ascii	" Xmodem (128 byte) blocks"<cr><lf>	; tag file size
	.asciz	"Awaiting ready signal (^X aborts).."	; ready to rip..
xmo.05:	.asciz	"File transfer completed"
.endc	;RT11				; /E64/
	.even


	.psect	$code
	.sbttl	Send file(s)		; /BBS/ somewhat modified..
					; /62/ moved here for smaller root
c$send::clr	wasmore			; init multi-args display flag
	tst	inopn			; is an input file currently open?
	beq	10$			; no
	calls	close	,<#lun.in>	; yes, please close old file up
10$:	mov	argbuf	,r1		; address of command line buffer
	tstb	@r1			; anything there?
	beq	20$			; no
	call	isitas			; SEND file asfile?  get asname
	tst	r0			; any parse error?
	beq	30$			; no
20$:	mov	#er$snd	,r0		; emit a syntax error message
	br	50$			; goto error handler

30$:	calls	chk.tt	,<#srcnam>	; /63/ disallow TT as an input dev
	tst	r0			; /63/ well?
	bne	50$			; /63/ it was TT
	tst	wasmore			; working with more than 1 file?
	beq	40$			; no
	calls	printm	,<#3,#sen.12,#srcnam,#sen.13> ; ya, say which it is
40$:	upcase	#srcnam			; upper case the input file name
	tst	remote			; in remote mode?
	beq	70$			; no
	clr	index			; /62/ init lookup's file counter
	calls	lookup	,<#srcnam,#spare1> ; /62/ look for something to do
	tst	r0			; /62/ well?
	beq	60$			; /62/ at least one file exists
	cmp	r0	,#er$nmf	; if error is "No more files"
	bne	50$			; then make it say
	mov	#er$fnf	,r0		; "File not found"
50$:	direrr	r0			; emit an error message
.if df	RT11				; /E64/
	.purge	#lun.sr			; /62/ hose dir search channel
.endc	;RT11				; /E64/
	br	130$			; go say it's over..

60$:	calls	suspend	,<sendly>	; allow time to start REC at other end

70$:	call	opentt			; open and initialize the link
	tst	r0			; did it work?
	bne	120$			; no, error displayed by ttyini
	call	cantyp			; flush any accumulated NAKs
80$:	calls	xbinread,<#-1>		; /63/ read with no wait to flush
	tst	r0			; /63/ any possible junk in buffer
	beq	80$			; /63/ loop until nothing remains
	tst	locase			; SET FIL NAM LOWER-CASE?
	bne	90$			; ya, leave output file name..
	upcase	#asname			; no, make it upper case
90$:	clr	index			; /62/ wildcard_file_number := 0
	call	getnxt			; get the first file name please
	tst	r0			; did it work?
	bne	120$			; no, getnxt has sent the error packet
	mov	sp	,inprogress	; packets are being exchanged
	calls	sensw	,<#msg$snd>	; now send the file
	tst	r0			; did it work?
	bne	120$			; no
	mov	nextone	,r0		; ya, any more arguments to process?
	bne	100$			; ya, go do it
	calls	printm	,<#1,#sen.10>	; no, done
	br	140$			; note r0 is clear here too
100$:	cmpb	(r0)	,#space		; is first byte a blank?
	bne	110$			; no
	inc	r0			; ya, skip past it
	br	100$			; and check what is now the first byte
110$:	copyz	r0 ,argbuf ,#ln$max	; pull up remaining args to top of buf
	jmp	10$			; /63/ loop back for more

120$:	calls	printm	,<#1,#sen.11>	; it failed, say so if local
130$:	inc	status			; /45/ flag for batch exit
140$:	clrb	asname			; /36/ ensure no more alternate names
	call	clostt			; release the link
	jmp	clrcns			; /62/ flush TT input, clear r0


	.sbttl	XMODEM a file		; /62/ moved this here too..

.if df	RT11				; /E64/
c$xmodem::tst	tsxsav			; send only, via TT only
	bne	10$			; must be TSX for this to work
	mov	#er$tsx	,r0		; say it's not TSX
	br	60$			; goto error handler

10$:	tst	inopn			; input file currently open?
	beq	20$			; no
	calls	close	,<#lun.in>	; yes, please close old file first
20$:	upcase	argbuf			; upper case all command args
	mov	argbuf	,r1		; address of command line buffer
	tstb	@r1			; anybody home?
	bne	30$			; ya
	mov	er$wld	,r0		; no, point to err msg
	beq	60$			; goto error message output
30$:	mov	#srcnam	,r2		; where to store file name
40$:	movb	(r1)+	,(r2)+		; copy the name over
	beq	50$			; can't XMODEM file asfile
	cmpb	@r1	,#space		; so stop at first space
	bgt	40$			; next byte
	clrb	@r2			; ensure source name is asciz
50$:	calls	iswild	,<#srcnam>	; check for wildcarding
	tst	r0			; if .ne., then wildcarded
	bne	60$			; can't process wildcards
	calls	fparse,<#srcnam,#filnam>  ; parse file name
;.if df	RSTS				; /E64/
;	tst	r0			; /E64/ if access restricted
;	bne	60$			; /E64/ then die
;.endc	;RSTS				; /E64/
	calls	open,<#filnam,#lun.in,#binary>  ; try to open the file
	tst	r0			; did it work?
	beq	70$			; ya..
60$:	direrr	r0			; no.. print mapped error msg
	call	incsts			; /62/ set global error flag
	br	80$			; and bail out

70$:	call	x$modem			; run xmodem
	calls	close	,<#lun.in>	; close file
	.newline			; ensure prompt is on a newline
80$:	clr	r0			; any error was already handled
	return
.endc	;RT11				; /E64/

.if df	RSTS				; /E64/
c$xmodem::mov	#er$uns	,r0		; /E64/  say it's unsupported
	direrr	r0			; /E64/
	call	incsts			; /E64/ set global error flag
	clr	r0			; /E64/ any error was already handled
	return				; /E64/
.endc	;RSTS				; /E64/

	.sbttl	Initialization

.if df	RT11				; /E64/
x$modem:.scca	#ttctlc	,#ttctlc+4	; /62/ off ^C
	.cmkt	#marea	,#40		; and setcc's mark timer
	clr	xmosts			; clear status word
	wrtall	#xmo.01			; /63/ "File open: "
	wrtall	#filnam			; print file specification
	wrtall	#xmo.02			; /63/ "["
	mov	#lun.in	,r4		; get I/O channel number
	asl	r4			; word indexing
	mov	sizof(r4),r0		; /63/ recover the file size
	call	L10266			; /63/ dump it to the terminal
	wrtall	#xmo.03			; /63/ "], "
	mov	buflst(r4),rbuff	; file input buffer pointer
	mov	sizof(r4),r1		; get file size
	mov	r1	,block		; save size of file in blocks
	clr	r0			; clear hi word
	asl	r1			; non-eis
	adc	r0			; 32-bit
	asl	r1			; multiply
	adc	r0			; by four
	mov	r0	,xblock		; save hi word
	mov	r1	,xblock+2	; save low word
	clr	r2			; suppress leading 0s in $cddmg output
	mov	#xblock	,r1		; address of 32-bit number
	mov	#sizbuf	,r0		; address of out buff for ascii
	call	$cddmg			; convert 32-bit integer to ascii
	clrb	@r0			; null terminate the string
	wrtall	#sizbuf			; and dump it to TT
	wrtall	#xmo.04			; /63/ tag & say awaiting ready signal
	call	l$nolf			; /63/

	mov	#nosingle,r0		; single char input dies in hieff mode
	emt	375			; if activation chars are declared
	calls	t.ttyini,<#0>		; init TT
	movb	#1	,hieff		; setup high efficiency emt
	mov	#hieff	,r0
	emt	375			; do it

	call	waitnk			; look for the initial NAK
	tst	aflag			; error detected?
	bne	abort			; yes, kill transfer
	clr	blkcnt			; clear block count
	mov	#1	,xrecno		; init xmodem block count
	.br	dnload			; /63/

.endc	;RT11				; /E64/

	.sbttl	Download

.if df	RT11				; /E64/
dnload:	call	rdblk			; read some input
	bcs	eof			; branch if EOF
10$:	call	sndblk			; send a checksummed block
	call	getack			; look for ACK from remote
	tst	aflag			; check result from receiver
	beq	20$			; zero is an ACKed block
	cmp	#1	,aflag		; 1 means we NAKed it
	beq	10$			; so send it again
	jmp	abort			; else we abort the transfer
20$:	inc	xrecno			; bump record number
	add	#128.	,point		; update buffer pointer
	cmp	point	,bytcnt		; are we at the end of buffer?
	beq	dnload			; yes, then better read in some more
	br	10$			; else go send another block

.endc	;RT11				; /E64/

	.sbttl	End of file processing

.if df	RT11				; /E64/
eof:	mov	#eot	,r0		; send end of transmission
	.ttyout
	call	getack			; wait for an acknowledgment
	tst	aflag			; check result
	beq	10$			; zero means all ok!
	cmp	#1	,aflag		; 1 means they NAKed it
	beq	eof			; so try it again
	br	abort			; else we need to abort
10$:	beep2
	.newline
	wrtall	#xmo.05			; /63/ "File transfer completed"
	br	reset			; and reset parameters

.endc	;RT11				; /E64/

	.sbttl	Clean up and exit Xmodem

.if df	RT11				; /E64/
abort:	beep2
	.newline
	direrr	#er$abt			; aborting transfer..

reset:	.twait	#rtwork	,#xtime		; wait for remote to come back
10$:	mov	#onewide,r0		; kludge single char input
	emt	375
	.ttinr				; suck up garbage
	bcc	10$
	clrb	hieff			; set emt argument off hi eff mode
	mov	#hieff	,r0
	emt	375			; do it
	call	ttyrst			; use existing TT reset stuff
	mov	#single	,r0		; restore single char input mode
	emt	375
	clr	r0			; no errors passed back..
	return

.endc	;RT11				; /E64/

	.sbttl	Wait for initial NAK from remote

.if df	RT11				; /E64/
waitnk:	clr	aflag			; clear abort flag
	mov	#nkwait*60.,mtime+2	; wait for preset time
	call	stimer			; start the timer
10$:	mov	#onewide,r0		; kludge single char input
	emt	375
	.ttinr				; pick up a character
	bcc	20$			; did we get something?
	tst	tflag			; no, did we time-out?
	bne	30$			; yes, we should abort this
	.twait	#rtwork	,#wtime		; else sleep a bit, so we don't burn
	br	10$			; up the cpu time.  Then check again
20$:	cmpb	r0	,#nak		; did we get a NAK?
	beq	40$			; yes, return normally
	cmpb	r0	,#can		; cancel transmission?
	beq	30$			; yes, abort this
	cmpb	r0	,#'C&137	; CRC checksum request?
	bne	10$			; nope
	bis	#crc	,xmosts		; ya, enable CRC mode
	br	40$
30$:	com	aflag			; else set abort
	br	50$
40$:	clr	aflag			; clear abort
50$:	.cmkt	#marea	,#41		; cancel timer
	return

.endc	;RT11				; /E64/

	.sbttl	Wait for ACK from remote

.if df	RT11				; /E64/
getack:	clr	aflag			; clear abort flag
10$:	mov	#onewide,r0		; kludge single char input
	emt	375
	.ttinr				; pick up a character
	bcc	20$			; did we get something?
	.twait	#rtwork	,#wtime		; no, sleep a bit, don't burn cpu time
	br	10$			; then check again
20$:	cmpb	r0	,#ack		; did we get an ACK?
	beq	40$			; yes, return normally
	cmpb	r0	,#nak		; did we get a NAK?
	beq	30$			; yes
	cmpb	r0	,#can		; cancel?
	bne	10$			; no, keep looking
	mov	#2	,aflag		; else set abort
	return
30$:	mov	#1	,aflag		; set aflag to 1
	return
40$:	clr	aflag			; clear abort
	return

.endc	;RT11				; /E64/

	.sbttl	Send a checksummed block to the remote

.if df	RT11				; /E64/
sndblk:	clr	chksum			; clear checksum
	clr	r3			; clear CRC
	mov	rbuff	,r1		; get address of read buffer
	add	point	,r1		; add in offset
	mov	#soh	,r0		; send a SOH
	.ttyout
	mov	xrecno	,r0		; send record number
	.ttyout
	com	r0			; send complement of record #
	.ttyout
	mov	#128.	,r2		; initialize counter
10$:	movb	(r1)+	,r0		; get next byte
	add	r0	,chksum		; update checksum
	call	updcrc			; update CRC
	.ttyout				; send it
	sob	r2	,10$		; finished?
	mov	chksum	,r0		; copy of checksum to send
	bit	#crc	,xmosts		; CRC enabled?
	beq	20$			; no
	call	getcrc			; get the CRC value
	swab	r0			; high byte first
	.ttyout
	swab	r0			; then low byte
20$:	.ttyout				; send checksum
	return

.endc	;RT11				; /E64/

	.sbttl	Read a block from the input file

.if df	RT11				; /E64/
rdblk:	clr	point			; clear pointer
	.readw	#rtwork,#lun.in,rbuff,#256.,blkcnt
	bcs	20$			; /63/ if EOF...
	asl	r0			; words to bytes, carry is clear here
	mov	r0	,bytcnt		; and store it
	inc	blkcnt			; update block cnt, carry still clear
10$:	return				; /63/ return with carry bit intact

20$:	movb	@#errbyt,r0		; make sure it is EOF
	beq	10$			; /63/ yes it is, carry is already set
	asl	r0			; not EOF, use word indexing to
	mov	reaerr(r0),r0		; point to error message text
	.newline			; ensure starting on a fresh line
	direrr	r0			; we had a read error!
	beep2				; this doesn't preserve r0..
	jmp	reset			; exit the program

.endc	;RT11				; /E64/

	.sbttl	Schedule a completion routine

.if df	RT11				; /E64/
stimer:	.cmkt	#marea	,#41		; cancel possible outstanding request
	clr	tflag			; clear timout flag
	.mrkt	#marea	,#mtime	,#timout,#41 ; issue a timer request
	return
timout:	com	tflag			; set timout flag to indicate time-out
	return

.endc	;RT11				; /E64/

	.sbttl	Update CRC, routine from Steve Brecher's COM program

.if df	RT11				; /E64/
; Update CRC in r3 with datum in the low byte of r0.  Registers preserved.
;
; Algorithm:	for each data bit from bit 7 to bit 0, shift the bit
;		into the LSB of the CRC.  If 1 shifts out of MSB of CRC,
;		XOR the CRC with the constant.

CON	= 10041		;constant = 1021 hex, for CCITT, recommended
			;polynomial of x**16 + x**12 + x**5 + 1

updcrc:	save	<r0,r1,r2>
	mov	#con	,r2		; the constant
	mov	#8.	,r1		; number of data bits
10$:	rolb	r0			; rotate left, byte mode
	rol	r3			; rotate left, word mode
	bcc	20$			; nothing shifted out of msb
	xor	r2	,r3		; something shifted out, fix it
20$:	sob	r1	,10$		; next data bit
	unsave	<r2,r1,r0>
	return

getcrc:	clr	r0			; after all data have passed through
	call	updcrc			; updcrc, call this routine to get the
	call	updcrc			; final CRC, for transmission, into r0
	mov	r3	,r0
	return
.endc	;RT11				; /E64/

	.end