;TRS-80 Model 100 -- Kaypro File Transfer Utility
;
;Transfers ASCII files to/from Model 100 at
;19200 baud.  Use setting 98N1E and Save & Load on Model 100
;Examples are:
;   In TEXT: Save to:com:98n1e
;   in BASIC: Save"com:98n1e"
;
;Requires RS-232 cable with "Null Modem Adapter"
;for computer interconnect.
;
;Written by Don Corbitt, Feb 1984
;
;Modified by Phil Wheeler, July 1984
;
;
	org	100h
boot	equ	0
bdos	equ	5
fcbl	equ	5ch
dbuff	equ	80h		; Disk i/o buffer
conin	equ	1		; Get char from console - wait
printf	equ	9		; Print buffer function (DE) until '$'
inlinf	equ	10		; Read buffer from console
openf	equ	15		; Open file,
closef	equ	16		; Close file after write
search	equ	17		; Look for file - ff if not found
readf	equ	20		; Read block from file
writef	equ	21		; Write block to file
makef	equ	22		; Make a file entry
baud	equ	0		; Port to set baud rate
uartd	equ	4		; Uart data port
uarts	equ	6		; Uart status port
bell	equ	7
cr	equ	13
lf	equ	10
nul	equ	0
eof	equ	1ah		; End of file signal
xoff	equ	19		; Stop transmission
xon	equ	17		; Start transmission

start:
	mvi	a,15		; 19200 baud
	out	baud
	mvi	b,9
	lxi	h,initcom	; String of chars to initialize uart
	mvi	c,uarts		; Set stat for 98n1e
	db	0edh,0b3h	; Otir
loop1:
	lxi	d,menu
	mvi	c,printf
	call	bdos
	mvi	c,conin
	call	bdos
	call	touppr		; Get upper case letters
	cpi	'Q'		; Return to CP/M
	rz
	cpi	'S'		; Send file to M100
	jz	send
	cpi	'R'		; Receive file from M100
	jz	receive
	jmp	loop1		; Try again
send:
	lxi	d,sndmsg	; 'Enter file to send'
	mvi	c,printf
	call	bdos
	call	gfspec		; Get the file name, and see if it exists
	jnz	sendit		; It exists, so send it
	lxi	d,nfmsg		; 'File doesn't exist'
	mvi	c,printf
	call	bdos
	jmp	loop1		; Try again
sendit:
	lxi	h,stbuff	; End of program - start of buffer
	push	h
	lxi	d,fcbl
	mvi	c,openf		; Open file and read contents
	call	bdos
sloop:	mvi	c,readf
	lxi	d,fcbl
	call	bdos
	ana	a		; Nz = EOF
	jnz	sendfil
	pop	d		; Current end of data
	lxi	h,dbuff		; Dma buffer - disk buffer
	lxi	b,80h		; Size of buffer
	db	0edh,0b0h	; Ldir (hl)->(de)
	push	d		; New end of data
	jmp	sloop

sendfil:
	call	motoff
;	in	28		; get contents of disk select port
;	ani	252		; de-select both drives
;	ori	64		; turn off motor
;	out	28		; rewrite port
;	mvi	c,closef	;close file now
;	lxi	d,fcbl		;set params
;	call	bdos
	pop	h		; Arrange stack - discard this value
	lxi	h,stbuff	; Buffer ended with EOF, OK?
sloop1:	mov	c,m		; Get first char
	inx	h
	call	rsout		; Send char
	cpi	eof
	jz	send		; End of file - send new file??
	call	rsist		; Char waiting??
	jz	sloop1
	call	rsin		; Get char
	cpi	xoff		; If xoff, then wait.....
	jnz	sloop1		; Else ignore it
sloop2:	call	rsin
	cpi	xon
	jnz	sloop2
	jmp	sloop1


;rs output status. Z if uart busy, NZ otherwise.  A modified.

rsost:
	in	uarts
	ani	4
	ret

;RS character out, character in C

rsout:				; Send byte in C to uart
	call	rsost
	jz	rsout
	mov	a,c
	out	uartd
	ret

;rs input status.  Z if no char waiting, NZ if char ready.

rsist:
	in	uarts
	ani	1		; Char waiting?
	ret

;get char from uart and return in A.

rsin:
	call	rsist
	jz	rsin		; Try again if one not waiting
	in	uartd
	ret

receive:
	lxi	d,recmsg
	mvi	c,printf
	call	bdos
	call	gfspec
	jz	rcvit		; Doesn't exist, so get it
	lxi	d,fexmsg
	mvi	c,printf
	call	bdos
	jmp	loop1
rcvit:
	lxi	d,fcbl
	mvi	c,makef
	call	bdos
	lxi	h,stbuff
rloop:	call	rsin		; Get a char
	mov	m,a		; And put in buffer
	inx	h
	cpi	eof		; If not last
	jnz	rloop		; Then get another
	lxi	h,stbuff
secloop:
	lxi	d,dbuff
	mvi	b,80h
byteloop:
	mov	a,m
	stax	d
	cpi	eof
	jz	lastone
	inx	h
	inx	d
	dcr	b
	jnz	byteloop
	call	wsect
	jmp	secloop

lastloop:
	stax	d
lastone:
	inx	d
	dcr	b
	jnz	lastloop
	call	wsect
	lxi	d,fcbl
	mvi	c,closef
	call	bdos
	jmp	receive		; End of file - get another one??
wsect:
	push	h		; Save position in buffer
	lxi	d,fcbl
	mvi	c,writef
	call	bdos
	pop	h
	ret
touppr:
	cpi	'a'
	rc
	cpi	'z'+1
	rnc
	ani	5fh
	ret

gfspec:
	lxi	h,fcbl
	mvi	b,33		; 33 bytes to erase
	xra	a
erase:	mov	m,a
	inx	h		; Next byte in fcbl
	dcr	b
	jnz	erase
	lxi	h,fcbl+1
	mvi	b,11		; File name block - default spaces
	mvi	a,32		; Space
erase1:	mov	m,a
	inx	h
	dcr	b
	jnz	erase1
	lxi	d,fbuff		; Buffer to hold file name
	push	d		; Save start of buffer
	mvi	c,inlinf	; Read line from keyboard
	call	bdos		; Get line
	pop	h		; Start of buffer (max count)
	inx	h		; Actual value returned
	mov	a,m
	ana	a		; No chars in queue??
	mov	b,a		; Count in b
	jnz	congsp		; If chars, continue get file spec
	pop	h		; Remove one level of subroutines
	jmp	loop1		; Start over with menu
congsp:
	inx	h		; First char of fspec
	inx	h		; Second char of fspec
	mov	a,m		; Get ':' if in fspec
	dcx	h		; First char of fspec
	cpi	':'
	mvi	a,0		; Zero (A) without affecting flags
	jnz	noprefix
	dcr	b
	dcr	b		; Skipping first two chars of buffer
	mov	a,m
	call	touppr
	sbi	'@'		; Get value from 1 to 17 (A to P)
	sta	fcbl		; Set drive number
	inx	h		; Point to ':'
	inx	h		; Point to first char of name
noprefix:
	lxi	d,fcbl+1	; Start of name section of fcbl
nprloop:
	mov	a,m
	call	touppr
	cpi	'.'
	jz	stext		; Start extension
	stax	d		; Put in fcbl
	inx	h
	inx	d
	dcr	b
	jnz	nprloop
exist:
	mvi	c,search
	lxi	d,fcbl
	call	bdos
	inr	a
	push	psw
	call	motoff
	pop	psw
	ret
motoff:	in	28
	ori	64
	out	28
	ret
stext:
	inx	h		; Skip '.'
	lxi	d,fcbl+9	; Start of extension
	dcr	b
	jz	exist		; Done
extloop:
	mov	a,m
	call	touppr
	stax	d
	inx	h
	inx	d
	dcr	b
	jnz	extloop
	jmp	exist


fbuff:	db	18
	ds	18


fexmsg:	db	bell,cr,lf,'File already exists',cr,lf,'$'
recmsg:	db	cr,lf,'File to recieve: $'
sndmsg:	db	cr,lf,'File to send: $'
nfmsg:	db	bell,cr,lf,'File doesn''t exist!!',cr,lf,'$'
menu:	db	cr,lf,lf
	db	'Use with COM:98N1E & Save or Load on Model 100'
	db	cr,lf,'Works with TEXT or BASIC',cr,lf,lf
	db	'Selections are:',cr,lf,lf
	db	'  [Q] Return to CP/M',cr,lf,'  [S] Send file to M100'
	db	cr,lf,'  [R] Receive file from M100',cr,lf
	db	cr,lf,'Enter your selection: $'
initcom:
	db	00h,18h,04h,44h,03h,0c1h,05h,0eah
endbuff:
	dw	0
stbuff	equ	$		; Start of free space
	end	start