page	56
	title	'CP/M MODEM7 PROGRAM'
;		CP/M MODEM PROGRAM

;THE FOLLOWING IS AN EXTENSIVE REVISION OF THE CP/M MODEM PROGRAM
;CREATED BY WARD CHRISTENSEN FOR THE CP/M USERS LIBRARY.
;IT ALSO INCORPORATES ROUTINES FOUND IN THE POTOMAC MICRO-MAGIC MODEM
;MANUAL WHICH MAY BE USED IF YOU HAVE A PMMI MODEM BOARD.

;THE ADDITIONAL ROUTINES ARE COPYRIGHTED (1980) BY:

;Mark M. Zeiger		and	James K. Mills
;198-01B 67th Ave.		824 Jordan Place
;Flushing, N.Y. 11365		Rockford, IL  61108
;(212) 454-6985			(815) 398-0579

;Permission is granted to use, but not to sell, these routines.

;  13 Feb 83	Modified by S. E. Andrews, major changes marked "** TA"
;
;	Note: All Baud Rates supported by the Z100 and this program do
;	work. However, only baud rates up to 1200 should be considered
;	reliable since the received 'Characters Per Second' above 1200
;	'Bits Per Second' are generally too fast for this programs
;	BIOS CALLS to handle when viewing the file being transfered.
;	38400 baud will not support file transfers at all, 19200 will
;	file transfer most of the time, 9600 and 4800 will generally
;	transfer files if not viewed.
;
;  13 Oct 82   Modified by Robert A. Ross Jr to work with
;              the H-89 system with the H-89-11 Multi-mode
;	       card installed.  This revision will also work
;	       on the Zenith Z-100 using CP/M-85.
;
;		Set the following equates depending on which system
;		you are using:
;		LABEL		H-89		Z-100
;		PORT		0D8H		0ECH
;		FASTCLK		FALSE		TRUE
;	
; REVISION 6 January 1982 by Sanford R. Smith
;	-- Modified MODEM7 to operate
;	on the HEATH / ZENITH H89/Z89 Systems using CPM.
;	Modification assumes use of the 8250 ACE.
;
;REVISION 12/18/80 -- changed disconnect timing


	MACLIB MODEM	;CONTAINS CMDLINE, INBUF, INLNCOMP,
			;DIR, AND MFACCESS ROUTINES
			;changed to MODEM.LIB by Jim Mills
			;to differentiate from other 'MACROS.LIB'

; minor revision 10/26/80 to allow 25-second 'wait' after pmmi
; autodial -- longer time required for Chicago CBBS*.  Jim Mills.
; * CBBS is a trademark of Ward Christensen and Randy Suess.

FALSE	EQU	0
TRUE	EQU	NOT FALSE
; PMMI EQUATES

PORT	EQU	0ECH		;modem BASE ADDRESS

moddatp	equ	port		;modem data port
modlcr	equ	port+2		;MODE CONTROL REGISTER
modmcr	equ	port+3		;COMMAND REGISTER
modlsr	equ	port+1		;STATUS REGISTER
MODSNDB	EQU	01H		;MODEM SEND BIT (XMIT BUFF EMPTY)
MODSNDR	EQU	01H		;MODEM SEND READY
MODRCVB	EQU	02H		;MODEM RECEIVE BIT (DAV)
MODRCVR	EQU	02H		;MODEM RECEIVE READY
;
MODIER	EQU	00H
MODIIR	EQU	00H
MODMSR	EQU	PORT+1
MODDLL	EQU	00H
MODDLM	EQU	00H
;
;
;  DEFINITIONS FOR 2661-2 EPCI (ENHANCED PROGRAMMABLE COMM. INTERFACE)
;
EP$BAS	EQU	0ECH		;2661-2 BASE ADDRESS
;
;  PORT DISPLACEMENTS
;
EP$DAT	EQU	0		;DATA
EP$SR	EQU	1		;STATUS REGISTER
EP$MR1	EQU	1		;STATUS
EP$MR2	EQU	2		;MODE REGISTER 2
EP$CR	EQU	3		;COMMAND REGISTER
EP$INT	EQU	4		;INTERRUPT ENABLE (Z-89-11, NOT PART OF 2661)
;
;  STATUS REGISTER BITS
;
SR$TXR	EQU	00000001B	;TRANSMITTER READY
SR$RXR	EQU	00000010B	;RECEIVER READY
SR$TXE	EQU	00000100B	;TRANSMITTER EMPTY
SR$DSC	EQU	00000100B	;DSR CHANGED STATE
SR$PER	EQU	00001000B	;PARITY ERROR
SR$OVE	EQU	00010000B	;OVER RUN ERROR
SR$FRE	EQU	00100000B	;FRAMING ERROR
SR$SYD	EQU	00100000B	;SYNC DETECT (SYNC. MODE)
SR$DCD	EQU	01000000B	;DATA CARRIER DETECT
SR$DSR	EQU	10000000B	;DATA SET READY
;
;  MODE REGISTER 1 (MR1)
;
MR1$MBM	EQU	00000011B	;MODE AND BAUD CLOCK MASK
MR1$S1X	EQU	00H		;SYNC. 1X CLK
MR1$A1X	EQU	01H		;ASNYC. 1X CLK
MR1$A16	EQU	02H		;ASYNC. 16X CLK
MR1$A64	EQU	03H		;ASYNC. 64X CLK
;
MR1$CLM	EQU	00001100B	;CHARACTER LENGTH MASK
MR1$5BW	EQU	00H		;5 BIT CHARACTERS
MR1$6BW	EQU	04H		;6 BIT CHARACTERS
MR1$7BW	EQU	08H		;7 BIT CHARACTERS
MR1$8BW	EQU	0CH		;8 BIT CHARACTERS
;
MR1$PEN	EQU	00010000B	;PARITY ENABLE (0=DISABLE, 1=ENABLE)
MR1$PEV	EQU	00100000B	;EVEN/ODD PARITY (0=ODD, 1=EVEN)
;
MR1$SBM	EQU	11000000B	;(ASYNC.) STOP BIT MASK
MR1$1SB	EQU	040H		;1 STOP BIT
MR1$15B	EQU	080H		;1.5 STOP BIT
MR1$2SB	EQU	0C0H		;2 STOP BITS
;
MR1$TSP	EQU	01000000B	;(SYNC) TRANSP. MODE (0=NORMAL, 1=TRANSP)
MR1$NSC	EQU	10000000B	;(SYNC) NR. OF SYNC CHARS (0=SINGLE, 1=DOUBLE)
;
;  MODE REGISTER 2 (MR2)
;
MR2$BRM	EQU	00001111B	;BIT RATE MASK
MR2$CKS	EQU	11110000B	;CLOCK SELECT MASK (SEE DATA SHEET)
;
;  COMMAND REGISTER (CR)
;
CR$TXEN	EQU	00000001B	;TRANSMITTER ENABLE
CR$DTR	EQU	00000010B	;DTR ASSERTED (=LOW)
CR$RXEN	EQU	00000100B	;RECEIVER ENABLED
CR$SBRK	EQU	00001000B	;SEND BREAK (ASYNC.)
CR$SDLE	EQU	00001000B	;SEND DLE (SYNC.)
CR$RESE	EQU	00010000B	;RESET ERRORS IN SR
CR$RTS	EQU	00100000B	;RTS ASSERTED (=LOW)
;
CR$OMM	EQU	11000000B	;OPERATING MODE MASK
CR$NML	EQU	00H		;NORMAL
CR$OM1	EQU	40H		;MODE 1 (ASYNC=AUTO ECHO/SYNC=SYN/DLE STRP)
CR$OMLL	EQU	80H		;LOCAL LOOPBACK
CR$OMRL	EQU	0C0H		;REMOTE LOOPBACK
;
IE$EN	EQU	00000001B	;1=ENABLE EPCI INTERRUPTS, 0=DISABLE
;
CHGBAUD	EQU	'B'-40H		;USED IN TERMINAL MODE TO CHANGE
				;BAUD RATE 'ON THE FLY'
ERRLIM	EQU	10		;NUMBER OF TIMES TO RETRY
				;SEND/RECEIVE ERRORS BEFORE QUIT
EXITCHR	EQU	'E'-40H		; ^E = EXIT WITHOUT DISCONNECT
DISCCHR	EQU	'D'-40H		; ^D = DISCONNECT
TRANCHR	EQU	'T'-40H		; ^T = TRANSFER CHARACTER
CAN	EQU	'X'-40H		; ^X = CANCEL SEND/RECEIVE
EOFCHAR	EQU	'Z'-40H		; ^Z = END OF FILE
SAVECHR	EQU	'Y'-40H		; ^Y = SAVE CHARACTER
XOFF	EQU	'S'-40H		; ^S = XOFF CHARACTER
XON	EQU	'Q'-40H		; ^Q = XON CHARACTER
SOH	EQU	1		; START OF HEADER
EOT	EQU	4		; END OF TEXT
ACK	EQU	6		; ACKNOWLEDGE
NAK	EQU	15H		; NOT ACKNOWLEDGE
BDNMCH	EQU	75H		; BAD NAME MATCH
OKNMCH	EQU	ACK		; OKAY NAME MATCH
LF	EQU	10		; LINEFEED
CR	EQU	13		; CARRIAGE RETURN
BELL	EQU	7		; BELL CHARACTER
;FRONTPAN EQU	0FFH		; IMSAI FRONT PANEL			** ??

BOTTRAM	SET LAST+100H AND 0FF00H

	ORG	100H

	JMP	START

;THESE ROUTINES ARE AT THE BEGINNING OF THE PROGRAM SO
;THEY CAN BE PATCHED BY A MONITER WITHOUT RE-ASSEMBLING
;THE PROGRAM.

PMMIBYTE	DB	TRUE		;true=pmmi modem
IMSAIBYTE	DB	FALSE		;true=imsai front panel
FASTCLK		DB	TRUE 		;4 MHz or greater
BAKUPBYTE	DB	TRUE 		;true=make .BAK file
XPRFLG		DB	false		;true=no menu, false=print menu
IN$MODlsr	IN	MODlsr  ! RET	;in modem control port
out$modlsr	out	modlsr  ! ret
;
OUT$MODDATP	PUSH	PSW
OUT267		IN	EP$BAS+EP$SR
		ANI	SR$TXR
		JZ	OUT267
		POP	PSW
		OUT	EP$BAS+EP$DAT
		RET
;
ANI$MODSNDB	ANI	MODSNDB ! RET	;bit to test for send ready
CPI$MODSNDR	CPI	MODSNDR ! RET	;value of send bit when ready
IN$MODDATP	IN	EP$BAS+EP$DAT
		ORA	A		;CLEAR FLAGS
		RET

ANI$MODRCVB	ANI	MODRCVB ! RET	;bit to test for receive ready
CPI$MODRCVR	CPI	MODRCVR ! RET	;value of receive bit when ready
;  Following corrects droping back to default baud rate			** TA
;JMP$INITMOD	JMP	setbaud		;to initialize port, if necessary
JMP$INITMOD	JMP	INITMOD		;initialize port after S,R,T or E
OUT$modlcr	OUT	MODlcr ! RET	;out modem control port
OUT$moddll	OUT	moddll ! RET	;out baudrate port 1
OUT$moddlm	OUT	moddlm ! RET	;out baudrate port 2
out$modier	out	modier ! ret	;out interrupt enable 
out$modiir	out	modiir ! ret	;out interrupt id reg
out$modmcr	out	modmcr ! ret	;out modem control reg
in$modmcr	in	modmcr ! ret
in$iir		in	modiir ! ret
in$lcr		in	modlcr ! ret
in$msr		in	modmsr ! ret	;in modem status reg

CRFLAG		DB	0		;CONTINUOUS REDIAL FLAG

START:	LXI	H,0
	DAD	SP		;GET CP/M'S STACK
	SHLD	STACK		;SAVE IT
	LXI 	SP,STACK	;START LOCAL STACK
	
	CALL	INITMOD
	CALL 	START1

;	DB 	CR,LF,'         MODEM7 as of 2/16/83',cr,lf
;	DB 	'Originally Written by: Ward Christensen',cr,lf
;	DB 	'Revisions by: Mark M. Zeiger, Jim Mills',cr,lf
;	DB	'R. Ross Jr., S. R. Smith, S. E. Andrews',CR,LF,LF
	DB	CR,LF,'   >>>   MODEM7 for the Zenith Z100  Version 1.03   <<<','$'

START1:	POP 	D		;GET ADDRESS OF ABOVE MESSAGE
	MVI 	C,PRINT		; 9
	CALL 	BDOS

	CALL 	INITADR		;INITIALIZE ADDRESSES
	MVI 	A,TRUE		; 0FFH
	STA 	NFILFLG
	CMA			; 0
	STA 	SAVEFLG
;	OUT 	FRONTPAN	; IMSAI					** ??

	CALL 	PROCOPT		;PROCESS CONTROL OPTIONS
	LDA 	OPTION		;GET MAIN OPTION
	CPI 	'X'		;EXPERT FLAG?
	JNZ 	RESTART		;NO
	MVI 	A,TRUE		;YES
	STA 	XPRFLG		;MAKE EXPERT
	JMP 	MENU

;   Process Menu options ' ', 'M', 'E', 'T', 'S', 'R'

RESTART: LDA 	OPTION		;GET MAIN OPTION
	CPI 	' '		;NO OPTION SPEC'D?
	JZ 	MENU		;TRUE, GO MENU
	CPI 	'M'		;MENU ASKED FOR?
	JZ 	MENU		;YES, GO MENU
	CALL 	JMP$INITMOD	; initalize modem port
	CALL 	MOVEFCB
	MVI 	A,FALSE		; reset write to memory
	STA 	NFILFLG		; .. in terminal mode
	CALL 	IN$MODDATP	;GOBBLE UP GARBAGE..
	CALL 	IN$MODDATP	;..CHARACTERS ON LINE
	LDA 	OPTION		;PROCESS MAIN OPTION
	CPI 	'E'		;ECHO MODE?
	JZ 	TRMECHO		;YES
	CPI 	'T'		;TERMINAL MODE?
	JZ 	DSKSAVE		;YES
	CPI 	'S'		;SEND A FILE?
	JZ 	SENDFIL		;YES
	CPI 	'R'		;RECEIVE A FILE?
	JZ 	RCVFIL		;YES
;	CPI 	'D'		;DISCONNECT?				** ??
	JMP 	MENU		;NO OPTION SPEC'D, GO MENU

;   REVISED TERMINAL ROUTINE ALLOWING MEMORY SAVE	"T" pri command
;	Note that characters typed from terminal will be saved
;	also because they are echoed back from distant end.

DSKSAVE: PUSH PSW
	XRA	A		; undo "E" pri commands patch		** TA
	STA	NOTOG+3		; by storing 0,0,0			**  |
	STA	NOTOG+4
	STA	NOTOG+5
	STA	TERML+0FH	; and another 0,0,0
	STA	TERML+10H
	STA	TERML+11H	;					**  |
	POP PSW			;					** TA

DSKSAV1: LDA 	NFILFLG		;NEW FILE FLAG				** TA
	CPI 	TRUE		;OFFH? (TRUE=NORMAL TERMINAL MODE)
	JZ 	TERM		;YES
	LDA 	FCB+1		;FIRST CHAR OF FILENAME
	CPI 	' '		;FILE SPEC'D
	JNZ 	GOODNM		;YES, GOOD NAME
	MVI 	A,TRUE		;0FFH no file specified
	STA 	NFILFLG		;.. so no saving
	CMA			; 0
	STA 	SAVEFLG		;
	JMP 	TERM

GOODNM:	CALL 	ERASFIL		; see if file exists now and prompt
	CALL 	MOVE2
	LXI 	D,FCB3
	MVI 	C,MAKE
	CALL 	BDOS
	LXI 	D,FCB3
	MVI 	C,OPEN
	CALL 	BDOS
	LXI 	H,BOTTRAM
	SHLD 	HLSAVE
	MVI 	A,FALSE
	STA 	NFILFLG

TERM:	CALL 	STAT		; KEYPRESS ?
	JZ 	TERML		; .. no, check modem
	CALL 	KEYIN		; .. yes, GET CHAR FROM KBD
	CPI 	EXITCHR		; ^E ?
	JZ 	MENU		; .. YES, RETURN TO MENU

;	CPI 	DISCCHR		; ^D ?					** ??
;	JZ 	menu		; .. YES, DISCONNECT & RETURN TO MENU	** ??

	CPI 	TRANCHR		; ^T ?  TEST FOR TRANSFER REQUEST
	CZ 	TRANSFER	; .. yes, SEND-A-FILE (BLIND SEND)
	JZ 	TERM		; return from transfer and LOOP
	CPI 	CHGBAUD		; ^B ?
	PUSH 	PSW
	PUSH 	H
	CZ 	NEWBAUD		; .. yes, so set new baud rate
	POP 	H
	POP 	PSW
	CPI 	CHGBAUD		; ^B ?
	JZ 	TERML		; .. if so, already processed so go loop
	CPI 	SAVECHR		; ^Y
	JNZ 	NOTOG		; .. none of the above so send it
	LDA 	NFILFLG		; do not allow save option if
	CPI 	TRUE		; .. this flag is FFH.
	JZ 	TERML		; .. so ignore ^Y
	LDA 	SAVEFLG		; get save flag
	CMA			; .. toggle it
	STA 	SAVEFLG		; .. and save it
	JMP 	TERML

NOTOG:	CALL 	OUT$MODDATP	; send typed char to modem
	DB	0,0,0		; patched by "E" pri command		** TA
;				;  to send typed char to terminal
TERML:	CALL 	IN$MODlsr	; check modem control port
	CALL	ANI$MODRCVB	; anything at modem
	CALL	CPI$MODRCVR	; .. to read
	JNZ 	TERM		; no, so loop again
	CALL 	IN$MODDATP	; yes, so get it
	DB	0,0,0		; patched by "E" pri command		** TA
;				;  to echo character rcvd by
;				;  the modem back to the modem
;				;  and add LF if CR
	CPI 	0		; NUL ?
	JZ 	TERM		; yes, don't process
	ANI 	7FH		; strip parity
	cpi	7fh		; DEL ?
	jz	term		; yes, don't process

	CPI	07H		; less than a BEL ?			** TA
	JC	TERML2		; .. yes, so only save it		**  |
	CPI	0EH		; less than a SO ?
	JC	TERML1		; .. yes, so ok to send to terminal
	CPI	20H		; less than a SPACE ?			**  |
	JC	TERML2		; .. yes, so only save it		** TA

TERML1:	CALL 	TYPE		; send to terminal			** TA
TERML2:	PUSH 	PSW		;					** TA
	LDA 	SAVEFLG
	CPI 	FALSE
	JZ 	NOSAVE		; don't save, loop
	POP 	PSW
	MOV 	M,A		; save it
	INX 	H
	SHLD 	HLSAVE		;MENU COMMAND DESTROYS HL-REG..
				;..GET HL WHEN ENTERING VIA 'RET' CMD.

COLON:	CPI 	LF		;IF NO FRONT PANEL, THEN..
	JNZ 	NOCOLON		;..TYPE ":" AFTER EACH LINE FEED..
	MVI 	A,':'		;..WHEN MEMORY SAVE ACTIVE.
	CALL 	TYPE
NOCOLON: LDA 	7		;CHECK TO SEE IF..
	DCR 	A		;..PAGE BELOW BDOS HAS BEEN..
	CMP 	H		;..REACHED AND DISKSAVE IS NEEDED.
	CZ 	INTDSKSV
	JMP 	TERM

NOSAVE:	POP 	PSW
	JMP 	TERM

SAVEFLG: DB 	FALSE
LASTBYT1: DB 	0
LASTBYT2: DB 	0

INTDSKSV: MVI 	A,XOFF		;SEND A CTRL-S TO STOP..
	CALL 	OUT$MODDATP	;..REMOTE COMPUTER OUTPUT.

	MVI 	D,0		;D IS THE BUFFER COUNT
	CALL 	INMODEM		;GET LAST BYTES SENT..
	STA 	LASTBYT1	;..AFTER CTRL-S.
	CALL 	INMODEM		;ADD MORE CALLS TO INMODEM..
	STA 	LASTBYT2	;..AND STA LASTBYT# IF YOU ARE..
				;..LOSING BYTES WHEN MEMORY IS FULL.
	PUSH 	D
	CALL 	NUMREC1
	CALL 	WRTDSK		;WRITE THE RECORDS
	POP 	D

	LXI 	H,BOTTRAM
	INR 	D
	DCR 	D		;TEST BUFFER COUNT FOR ZERO
	JZ 	CTRLQ
	LDA 	LASTBYT1	;GET THE LAST BYTES THAT WERE..
	MOV 	M,A		;..SAVED AND PUT THEM IN..
	INX 	H		;..BOTTRAM.
	CALL 	TYPE
	DCR 	D
	JZ 	CTRLQ
	LDA 	LASTBYT2
	MOV 	M,A
	INX 	H
	CALL 	TYPE

CTRLQ:	MVI 	A,XON		;SEND START CHARACTER..
	CALL 	OUT$MODDATP	;..TO REMOTE COMPUTER.
	RET

;THIS SUBROUTINE WILL LOOP UNTIL THE MODEM RECEIVES A CHARACTER
;OR 100 MILLISECONDS. IF A CHARACTER IS RECEIVED, A FLAG IS SET
;TO STORE THE CHARACTER. A MAXIMUM OF TWO CHARACTERS ARE STORED,
;BUT MORE MAY BE STORED IF DESIRED (SEE COMMENT IN "INTDSKSV"
;ABOVE).

INMODEM: LDA 	FASTCLK
	ORA 	A
	JZ 	SLOW
	LXI 	B,2500
	JMP 	TIMERL

SLOW:	LXI 	B,1250
TIMERL:	CALL 	IN$MODlsr
	CALL 	ANI$MODRCVB
	CALL 	CPI$MODRCVR
	JZ 	GETBYTE
	DCX 	B
	MOV 	A,B
	ORA 	C
	JNZ 	TIMERL
	RET

GETBYTE: CALL 	IN$MODDATP
	INR 	D
	RET

NUMRECS: MVI 	M,EOFCHAR
	INX 	H
	LXI 	D,127
	DAD 	D
NUMREC1: LXI 	D,-(BOTTRAM)
	DAD 	D

	MOV 	A,L		;DIVIDE HL BY 128..
	ORA 	A
	RAL			;..TO GET THE..
	MOV 	L,H		;..NUMBER OF SECTORS
	MVI 	H,0
	PUSH 	PSW
	DAD 	H
	POP 	PSW
	MVI 	A,0
	ADC 	L
	MOV 	L,A		;RETURNS WITH NUMBER OF..
	RET			;..128 BYTE RECORDS IN HL.

WRTDSK:	LXI 	D,BOTTRAM
NEXTWRT: MVI 	C,STDMA
	CALL 	BDOSRT
	PUSH 	D
	LXI 	D,FCB3
	MVI 	C,WRITE
	CALL 	BDOSRT
	POP 	D
	XCHG
	PUSH 	D
	LXI 	D,128
	DAD 	D
	POP 	D
	XCHG
	DCX 	H
	MOV 	A,H
	ORA 	L
	JNZ 	NEXTWRT
	RET

CLOSE3:	LXI 	D,FCB3
	MVI 	C,CLOSE
	CALL 	BDOS
	RET

BDOSRT:	PUSH B ! PUSH D ! PUSH H ! PUSH PSW
	CALL 	BDOS
	POP PSW ! POP H ! POP D ! POP B
	RET

MOVE2:	LXI 	H,FCB3
	CALL 	INITFCBS
	LXI 	H,FCB
	LXI 	D,FCB3
	MVI 	B,12
	CALL 	MOVE
	RET

;FILE TRANSFER ROUTINE - CALLED WITH 
;CONTROL-T FROM TERMINAL ROUTINE.
;TRANSFER MAY BE CANCELLED WHILE SENDING BY USING CONTROL-X.

TRANSFER: PUSH H ! PUSH D ! PUSH B ! PUSH PSW
	LXI 	H,FCB4
	CALL 	INITFCBS	;INITIALIZES FCBS POINTED..
	LXI 	H,FCB+16	;..TO BY HL REG.
	CALL 	INITFCBS
GET:	CALL 	GETNAME
	LDA 	CMDBUF+2	;WAS FILE ENTERED
	CPI 	20H
	JZ 	TRANSL2
	CALL 	MOVE4
	CALL 	OPEN4
	CPI 	0FFH		;RETURN WITH 0FFH MEANS
	JNZ 	CONTIN		;FILE DOES NOT EXIST
TRANSL1: CALL 	ILPRT
        DB 	CR,LF,LF,'++ FILE DOES NOT EXIST ++',CR,LF,BELL,0
TRANSL2: CALL 	ILPRT
        DB 	'TYPE "R" TO RETURN TO MODEM',CR,LF
        DB 	'TYPE "A" TO RE-ENTER NAME: ',BELL,0
	CALL 	KEYIN
	CALL 	UCASE
	CALL 	TYPE		;ECHO RESPONSE
	CALL 	CRLF
	CPI 	'A'
	JZ 	GET
	CPI 	'R'
	JZ 	RETURN
	JMP 	TRANSL2

CONTIN:	LXI 	D,80H
	MVI 	C,STDMA
	CALL 	BDOS
READMR:	CALL 	READ80
	CPI 	1		;END OF FILE
	JZ 	RETURNS
	CPI 	2		;BAD READ
	JZ 	RETURNU
	CALL 	SEND80C
	CPI 	EOFCHAR		;END OF FILE - OMIT IF OBJECT..
	JZ 	RETURNS		;..CODE IS TO BE SENT.
	CPI 	CAN		;CANCELLATION?
	JZ 	TRANCAN
	JMP 	READMR

RETURNS: CALL 	ILPRT
        DB 	CR,LF,LF,'++ FILE TRANSFER COMPLETED ++',CR,LF,BELL,0
	JMP 	RETURN

RETURNU: CALL 	ILPRT
        DB 	CR,LF,LF,'++ FILE TRANSFER UNSUCCESSFUL ++',CR,LF,BELL,0
	JMP 	RETURN

TRANCAN: CALL 	ILPRT
        DB 	CR,LF,LF,'++ TRANSFER CANCELLED ++',CR,LF,BELL,0
RETURN:	POP PSW ! POP B ! POP D ! POP H
	RET

INITFCBS:			;ENTRY AT +2 WILL LEAVE..
	MVI 	M,0		;..DRIVE NO. INTACT.
	INX 	H		;WILL INITIALIZE AN FCB..
	MVI 	B,11		;..POINTED TO BY HL-REG. FILLS 1ST POS
LOOP10:	MVI 	M,' '		;..WITH 0, NEXT 11 WITH..
	INX 	H		;..WITH BLANKS, AND LAST..
	DCR 	B		;..21 WITH NULLS.
	JNZ 	LOOP10
	MVI 	B,21
LOOP11:	MVI 	M,0
	INX 	H
	DCR 	B
	JNZ 	LOOP11
	RET

GETNAME: CALL 	ILPRT
        DB 	CR,LF,'ENTER FILE NAME TO BE TRANSFERRED -  C/R TO QUIT: ',0
	LXI 	D,CMDBUF
	CALL 	INBUFF
	CALL 	CRLF
	RET

MOVE4:	LXI 	D,CMDBUF
	LXI 	H,FCB4
	CALL 	CPMLINE
	RET

OPEN4:	LXI 	D,FCB4
	MVI 	C,OPEN
	CALL 	BDOS
	RET

READ80:	LXI 	D,FCB4
	MVI 	C,READ
	CALL 	BDOS
	RET

SEND80C: MVI 	B,80H
	LXI 	H,80H
SENDCH1: MOV 	A,M
	CALL 	MODOUT
	CPI 	EOFCHAR
	RZ
	CALL 	STAT		;TEST TO SEE IF
	ORA 	A		;CANCELLATION REQUESTED
	JZ 	SKIP12
	CALL 	KEYIN
	CPI 	CAN
	RZ
SKIP12:	INX 	H
	DCR 	B
	JNZ 	SENDCH1
	RET

MODOUT:	PUSH 	PSW
MODOUTL: CALL 	IN$MODlsr
	CALL 	ANI$MODSNDB
	CALL 	CPI$MODSNDR
	JNZ 	MODOUTL
	POP 	PSW
	CALL 	OUT$MODDATP
	CALL 	TYPE
	RET

FCB4:	DS 	33

;   TERMINAL ECHO MODE WITH OPTIONAL SAVE		"E" pri command
;	Note that characters typed from terminal can not be saved
;	because they are not echoed back from distant end.

PROTECT: CPI	07H		; less than a BEL ?			** TA
	RC			; .. yes, so forget it			**  |
	CPI	0EH		; less than a SO ?
	JC	PROTEC1		; .. yes, so ok to send to terminal
	CPI	20H		; less than a SPACE ?
	RC			; .. yes, so forget it
PROTEC1: CALL	TYPE		; send it to terminal
	RET

CONVERS: CALL	OUT$MODDATP	; send character out on modem
				; (place future "save" of typed
				; characters from terminal here)
	RET

TRMECHO: PUSH H ! PUSH PSW ! PUSH B ! PUSH D
	MVI	A,0CDH		; CALL instruction
	STA	NOTOG+3		; .. patched in
	STA	TERML+0FH	; .. two places
	LXI	H,PROTECT	; what to call, check for bad character
	SHLD	NOTOG+4		; where to store it
	LXI	H,CONVERS	; what to call, send echo back to modem
	SHLD	TERML+10H	; where to store it
	POP D ! POP B ! POP PSW ! POP H			;		**  |
	JMP	DSKSAV1		; routine to use after it's patched	** TA

;TRMECHO: CALL 	IN$MODlsr	; look at modem control port
;	CALL 	ANI$MODRCVB	; 
;	CALL 	CPI$MODRCVR	; anything there ?
;	JZ 	LINECHR		; .. yes, go get it
;	CALL 	STAT		; anything from the terminal ?
;	JZ 	TRMECHO		; .. no, loop
;	CALL 	KEYIN		; .. yes, get it
;	CPI 	EXITCHR		; ^E ?
;	JZ 	MENU		; .. yes, do a menu
;	CPI 	CHGBAUD		; ^B ?
;	PUSH 	PSW
;	CZ 	NEWBAUD		; .. yes, change baud
;	POP 	PSW
;	CPI 	CHGBAUD		; it might be ^B
;	JZ 	TRMECHO		; .. if it is, we already processed so loop
;	CALL 	OUT$MODDATP	; .. if none of the above, send it to modem
;	CALL 	TYPE		; .. and to the terminal
;	JMP 	TRMECHO		; loop again

LINECHR: CALL 	IN$MODDATP
	CALL 	OUT$MODDATP
	CALL 	TYPE
	JMP 	TRMECHO


;   SEND A CP/M FILE					"S" pri command

SENDFIL: LDA 	BATCHFLG	;CHECK IF MULTIPLE FILE..
	ORA 	A		;..MODE IS SET.
	JNZ 	SENDC1
	MVI 	A,TRUE		;INDICATE BATCH SEND
	STA 	SENDFLG
	LDA 	FSTFLG		;IF FIRST TIME THRU..
	ORA 	A		;..SCAN THE COMMAND LINE..
	CNZ 	TNMBUF		;..FOR MULTIPLE NAMES.
	CALL 	SENDFN		;SENDS FILE NAME TO RECEIVER
	JNC 	SENDC2		;CARRY SET MEANS NO MORE FILES.
	MVI 	A,'B'		;STOP BATCH..
	STA 	BATCHFLG	;..MODE OPTION.
	MVI 	A,EOT		;FINAL XFER END
	CALL 	SEND
	JMP 	DONE

SENDC1:	LDA 	FCB+1
	CPI 	' '
	JZ 	BLKFILE
SENDC2:	CALL 	OPENFIL
	MVI 	E,80
	CALL 	WAITNAK
SENDLP:	CALL 	RDSECT
	JC 	SENDEOF
	CALL 	INCRSNO
	XRA 	A
	STA 	ERRCT
SENDRPT: CALL 	SENDHDR
	CALL 	SENDSEC
	CALL 	SENDCKS
	CALL 	GETACK
	JC 	SENDRPT
	JMP 	SENDLP

SENDEOF: MVI 	A,EOT
	CALL 	SEND
	CALL 	GETACK
	JC 	SENDEOF
	JMP 	DONE

;   RECEIVE A FILE					"R" pri command

RCVFIL:	LDA 	BATCHFLG	;CHECK IF MULT..
	ORA 	A		;..FILE MODE.
	JNZ 	RCVC1
	MVI 	A,FALSE		;FLAG WHERE TO RETURN..
	STA 	SENDFLG		;..FOR NEXT FILE TRANS.
	CALL 	GETFN		;GET THE FILE NAME.
	JNC 	RCVC2		;CARRY SET MEANS NO MORE FILES.
	MVI 	A,'B'		;STOP BATCH..
	STA 	BATCHFLG	;..MODE OPTION.
	JMP 	DONE

RCVC1:	LDA 	FCB+1		;MAKE SURE FILE IS NAMED
	CPI 	' '
	JZ 	BLKFILE
	JMP 	RCVC3

RCVC2:	CALL 	CKCPM2
	CALL 	CKBAKUP
RCVC3:	CALL 	ERASFIL
	CALL 	MAKEFIL
	LDA 	QFLG
	ORA 	A
	JNZ 	RCVLP
	LDA 	BATCHFLG
	ORA 	A		;DON'T PRINT MSSG IF..
	JZ 	RCVLP		;..IN MULTI AND QUIET.
	CALL 	ILPRT
	DB 	'FILE OPEN, READY TO RECEIVE',CR,LF,0
RCVLP:	CALL 	RCVSECT
	JC 	RCVEOT
	CALL 	WRSECT
	CALL 	INCRSNO
	CALL 	SENDACK
	JMP 	RCVLP

RCVEOT:	CALL 	WRBLOCK
	CALL 	SENDACK
	CALL 	CLOSFIL
	JMP 	DONE
	
;   SUBROUTINES

SENDFN:	LDA 	QFLG
	ORA 	A
	JZ 	SWNAK
	CALL 	ILPRT
	DB 	'AWAITING NAME NAK',CR,LF,0
SWNAK:	MVI 	E,80
	CALL 	WAITNLP
	MVI 	A,ACK		;GOT NAK, SEND ACK
	CALL 	SEND
	LXI 	H,FILECT
	DCR 	M
	JM 	NOMRNM
	LHLD 	NBSAVE		;GET FILE NAME..
	LXI 	D,FCB		;..IN FCB
	MVI 	B,12
	CALL 	MOVE
	SHLD 	NBSAVE
	CALL 	SENDNM		;SEND IT
	ORA 	A		;CLEAR CARRY
	RET

NOMRNM:	MVI 	A,EOT
	CALL 	SEND
	STC
	RET

SENDNM:	PUSH 	H
SENDNM1: MVI 	D,11		;COUNT CHARS IN NAME
	MVI 	C,0		;INIT CHECKSUM
	LXI 	H,FCB+1		;ADDRESS NAME
NAMLPS:	MOV 	A,M		;SEND NAME
	ANI 	7FH		;STRIP HIGH ORDER BIT SO CP/M 2..
	CALL 	SEND		;..WON'T SEND R/O FILE DESIGNATION.
	LDA 	QFLG		;SHOW NAME IF..
	ORA 	A		;..QFLG NOT SET.
	MOV 	A,M
	CNZ 	TYPE
ACKLP:	PUSH 	B		;SAVE CKSUM
	MVI 	B,1		;WAIT FOR RECEIVER..
	CALL 	RECV		;..TO ACKNOWLEDGE..
	POP 	B		;..GETTING LETTER.
	JC 	SCKSER
	CPI 	ACK
	JNZ 	ACKLP
	INX 	H		;NEXT CHAR
	DCR 	D
	JNZ 	NAMLPS
	MVI 	A,EOFCHAR	;TELL RECEIVER END OF NAME
	CALL 	SEND
	LDA 	QFLG
	ORA 	A
	CNZ 	CRLF
	MOV 	D,C		;SAVE CHECKSUM
	MVI 	B,1
	CALL 	RECV		;GET CHECKSUM..
	CMP 	D		;..FROM RECEIVER.
	JZ 	NAMEOK
SCKSER:	MVI 	A,BDNMCH	;BAD NAME-TELL RECEIVER
	CALL 	SEND
	LDA 	QFLG
	ORA 	A
	JZ 	SKCSER1
	CALL 	ILPRT
	DB 	'CHECKSUM ERROR',CR,LF,0
SKCSER1: MVI 	E,80		;DO HANDSHAKING OVER
	CALL 	WAITNLP		;DON'T PRINT "AWAITING NAK" MSG
	MVI 	A,ACK
	CALL 	SEND
	JMP 	SENDNM1

NAMEOK:	MVI 	A,OKNMCH	;GOOD NAME-TELL RECEIVER
	CALL 	SEND
	POP 	H
	RET	

GETFN:	LXI 	H,FCB
	CALL 	INITFCBS+2	;DOES NOT INITIALIZE DRIVE
	LDA 	QFLG
	ORA 	A
	JZ 	GNAMELP
	CALL 	ILPRT
	DB 	'AWAITING FILE NAME',CR,LF,0
GNAMELP: CALL 	HSNAK
	JC 	GNAMELP
	CALL 	GETNM		;GET THE NAME
	CPI 	EOT		;IF EOT, THEN NO MORE FILES
	JZ 	NOMRNMG
	ORA 	A		;CLEAR CARRY
	RET

NOMRNMG: STC
	RET

GETNM:	PUSH 	H
GETNM1:	MVI 	C,0		;INIT CHECKSUM
	LXI 	H,FCB+1
NAMELPG: MVI 	B,5
	CALL 	RECV		;GET CHAR
	JNC 	GETNM3
	LDA 	QFLG
	ORA 	A
	JZ 	GETNM2
	CALL 	ILPRT
	DB 	'TIME OUT RECEIVING FILENAME',CR,LF,0
GETNM2:	JMP 	GCKSER

GETNM3:	CPI 	EOT		;IF EOT, THEN NO MORE FILES
	JZ 	GNRET
	CPI 	EOFCHAR		;GOT END OF NAME
	JZ 	ENDNAME
	MOV 	M,A		;PUT NAME IN FCB
	LDA 	QFLG		;TYPE IT IF NO QFLG
	ORA 	A
	MOV 	A,M
	CNZ 	TYPE
	PUSH 	B		;SAVE CKSUM
	MVI 	A,ACK		;ACK GETTING LETTER
	CALL 	SEND
	POP 	B
	INX 	H		;GET NEXT CHAR
	MOV 	A,L		;DON'T LET NOISE...
	CPI 	7FH		;..CAUSE OVERFLOW..
	JZ 	GCKSER		;..INTO PROGRAM AREA.
	JMP 	NAMELPG

ENDNAME: LDA 	QFLG
	ORA	A
	CNZ 	CRLF
	MOV 	A,C		;SEND CHECKSUM
	CALL 	SEND
	MVI 	B,1
	CALL 	RECV		;CHECKSUM GOOD?
	CPI 	OKNMCH		;YES IF OKNMCH SENT..
	JZ 	GNRET		;..ELSE DO OVER.
GCKSER:	LXI 	H,FCB		;CLEAR FCB (EXCEPT DRIVE)..
	CALL 	INITFCBS+2	;..SINCE IT MIGHT BE DAMAGED..
	LDA 	QFLG		;..BY TOO MANY CHARS.
	ORA 	A
	JZ 	GCKSER1
	CALL 	ILPRT
	DB 	'CHECKSUM ERROR',CR,LF,0
GCKSER1: CALL 	HSNAK		;DO HANDSHAKING OVER
	JC 	GCKSER1
	JMP 	GETNM1

GNRET:	POP 	H
	RET

HSNAK:	MVI 	A,NAK		;SEND NAK UNTIL..
	CALL 	SEND		;..RECEIVING ACK.
	CALL 	CKABORT		;DON'T GET HUNG UP HERE
	MVI 	B,2		;WAIT 2 SECONDS..
	CALL 	RECV		;..IN RECEIVE.
	CPI 	CAN		;IF SENDER ABORTS..
	JZ 	ABORT		;..DURING NAME TRANSFER.
	CPI 	ACK		;IF NAK,RETURN WITH..
	RZ			;..CARRY CLEAR.
	STC
	RET

TNMBUF:	MVI 	A,FALSE		;CALL FROM SENDFIL ONLY ONCE.
	STA 	FSTFLG
	STA 	FILECT
	CALL 	SCAN
	LXI 	H,NAMEBUF
	SHLD 	NBSAVE		;SAVE ADDR OF 1ST NAME
TNLP1:	CALL	TRTOBUF
	LXI 	H,FCB
	LXI 	D,FCBBUF
	CALL 	CPMLINE		;PARSE NAME TO CP/M FORMAT
TNLP2:	CALL 	MFNAME		;SEARCH FOR NAMES (* FORMAT)
	JC 	NEXTNM
	LDA 	FCB+10		;IF CP/M 2 $SYS FILE..
	ANI 	80H		;..DON'T SEND
	JNZ 	TNLP2
	LHLD 	NBSAVE		;GET NAME
	LXI 	D,FCB		;MOVE IT TO FCB
	XCHG
	MVI 	B,12
	CALL 	MOVE
	XCHG
	SHLD 	NBSAVE		;ADDR OF NEXT NAME
	LXI 	H,FILECT	;COUNT FILES FOUND
	INR 	M
	JMP 	TNLP2

NEXTNM:	LXI 	H,NAMECT	;COUNT NAMES FOUND
	DCR 	M
	JNZ 	TNLP1
	LXI 	H,NAMEBUF	;SAVE START OF BUFFER
	SHLD 	NBSAVE
	LDA 	FILECT
	CPI 	65		;NO MORE THAN 64 TRANSFERS
	RC
	MVI 	A,64		;ONLY X'FER FIRST 64
	STA 	FILECT
	RET

;SCANS CMDBUF COUNTING NAMES AND PUTTING DELIMITER (SPACE)
;AFTER LAST NAME

SCAN:	PUSH 	H
	LXI 	H,NAMECT
	MVI 	M,0
	LXI 	H,CMDBUF+1	;FIND END OF CMD LINE..
	MOV 	C,M		;..AND PUT SPACE THERE.
	MVI 	B,0
	LXI 	H,CMDBUF+2
	DAD 	B
	MVI 	M,20H
	LXI 	H,CMDBUF+1
	MOV 	B,M
	INR 	B
	INR 	B
SCANLP1: INX 	H
	DCR 	B
	JZ 	DNSCAN
	MOV 	A,M
	CPI 	20H
	JNZ 	SCANLP1
SCANLP2: INX 	H		;EAT EXTRA SPACES
	DCR 	B
	JZ 	DNSCAN
	MOV 	A,M
	CPI 	20H
	JZ 	SCANLP2
	SHLD 	BGNMS		;SAVE START OF NAMES IN CMDBUF
	INR 	B
	DCX 	H
SCANLP3: INX 	H
	DCR 	B
	JZ 	DNSCAN
	MOV 	A,M
	CPI 	20H
	JNZ 	SCANLP3
	LDA 	NAMECT		;COUNTS NAMES
	INR 	A
	STA 	NAMECT
SCANLP4: INX 	H		;EAT SPACES
	DCR 	B
	JZ 	DNSCAN
	MOV 	A,M
	CPI 	20H
	JZ 	SCANLP4
	JMP 	SCANLP3

DNSCAN:	MVI 	M,20H		;SPACE AFTER LAST CHAR
	POP 	H
	RET

;PLACES NEXT NAME IN BUFFER SO CPMLINE MAY PARSE IT

TRTOBUF: LHLD 	BGNMS
	MVI 	B,0
	LXI 	D,FCBBUF+2
TBLP:	MOV 	A,M
	CPI 	20H
	JZ 	TRBFEND
	STAX 	D
	INX 	H
	INX 	D
	INR 	B		;COUNT CHARS IN NAME
	JMP 	TBLP

TRBFEND: INX 	H
	MOV 	A,M		;EAT EXTRA SPACES
	CPI 	20H
	JZ 	TRBFEND
	SHLD 	BGNMS
	LXI 	H,FCBBUF+1	;PUT # CHARS BEFORE NAME
	MOV 	M,B
	RET

;IN CP/M V.2, IF FILE IS R/O OR SYS, IT IS CHANGED TO 'BAK'.

CKCPM2:	MVI 	C,12
	CALL 	BDOS
	ORA 	A		;RETURN 0 MEANS CP/M 1
	RZ
	MVI 	C,STDMA
	LXI 	D,80H
	CALL 	BDOS
	MVI 	C,SRCHF		;SEARCH FOR FILE
	LXI 	D,FCB
	CALL 	BDOS
	CPI 	0FFH
	RZ
	ADD A ! ADD A		;MULT A-REG BY..
	ADD A ! ADD A		;..32 TO FIND..
	ADD 	A		;..NAME IN DMA.
	LXI 	H,80H
	ADD 	L
	MOV 	L,A		;HL POINTS TO DIR NAME
	LXI 	D,9
	DAD 	D		;POINT TO R/O ATTRIB BYTE
	MOV 	A,M
	ANI 	80H		;TEST MSB
	JNZ 	MKCHG		;IF SET, MAKE CHANGE
	INX 	H		;CHECK SYSTEM ATTRIB BYTE
	MOV 	A,M
	ANI 	80H
	RZ			;NOT $SYS OR $R/O
	DCX 	H
MKCHG:	LXI 	D,-8
	DAD 	D		;POINT HL TO FILENAME + 1
	LXI 	D,FCB+1		;MOVE DIR NAME TO FCB..
	MVI 	B,11		;..WITHOUT CHANGING DRIVE.
	CALL 	MOVE
	LXI 	H,FCB+9		;R/O ATTRIB
	MOV 	A,M
	ANI 	7FH		;STRIP R/O ATTRIB
	MOV 	M,A
	INX 	H		;SYS ATTRIB
	MOV 	A,M
	ANI 	7FH
	MOV 	M,A
	LXI 	D,FCB
	MVI 	C,30		;SET NEW ATTRIBS IN DIR
	CALL 	BDOS

;MAY BE CALLED BY CKBAKUP BELOW. ITS RETURN DONE HERE

PLANCHG: LXI 	H,FCB		;CHANGE NAME TO TYPE "BAK"
	LXI 	D,6CH
	MVI 	B,9		;MOVE DRIVE AND NAME (NOT TYPE)
	CALL 	MOVE
	LXI 	H,75H		;START OF TYPE IN FCB2
	MVI 	M,'B'
	INX 	H
	MVI 	M,'A'
	INX 	H
	MVI 	M,'K'
	LXI 	D,6CH
	MVI 	C,ERASE		;ERASE ANY PREV BACKUPS
	CALL 	BDOS
	LXI 	H,6CH		;FCB2 DR FIELD SHOULD..
	MVI 	M,0		;..0 FOR RENAME.
	LXI 	D,FCB
	MVI 	C,23		;RENAME
	CALL 	BDOS
	RET

CKBAKUP: LDA 	BAKUPBYTE
	ORA 	A
	RZ
	MVI 	C,SRCHF
	LXI 	D,FCB
	CALL 	BDOS
	INR 	A
	RZ			;FILE NOT FOUND
	JMP 	PLANCHG		;IN "CKCPM2" - RET DONE THERE

;MULTI-FILE ACCESS SUBROUTINE FROM CP/M USER'S GROUP
;FIXED BY MARK ZEIGER 8/17/80
;CARRY IS SET IF NO MORE NAMES CAN BE FOUND

MFNAME:	MFACCESS		;A MACRO IN MACROS.LIB


RCVSECT: XRA 	A
	STA 	ERRCT
RCVRPT:	LDA 	QFLG
	ORA 	A
	JZ 	RCVSQ
	CALL 	ILPRT
	DB 	'AWAITING #',0
	LDA 	SECTNO
	INR 	A
	CALL 	HEXO
	CALL 	CRLF
RCVSQ:	MVI 	B,7		;10 IN ORIG PROG
	CALL 	RECV
	JC 	RCVSTOT
	CPI 	CAN		;CHECK FOR CANCEL..
	JZ 	ABORT		;..REQUEST FROM SENDER.
	CPI 	SOH
	JZ 	RCVSOH
	ORA 	A
	JZ 	RCVSQ
	CPI 	EOT
	STC
	RZ
	MOV 	B,A
	LDA 	VSEEFLG
	ORA 	A
	JZ 	RCVSEH
	LDA 	QFLG
	ORA 	A
	JZ 	RCVSERR
RCVSEH:	MOV 	A,B
	CALL 	HEXO
	CALL 	ILPRT
        DB 	'H RCD, NOT SOH',CR,LF,0

RCVSERR: MVI 	B,1
	CALL 	RECV
	JNC 	RCVSERR
	MVI 	A,NAK
	CALL 	SEND
	LDA 	ERRCT
	INR 	A
	STA 	ERRCT
	CPI 	ERRLIM
	JC 	RCVRPT
	LDA 	VSEEFLG
	ORA 	A
	JZ 	RCVCKQ
	LDA 	QFLG
	ORA 	A
	JZ 	RCVSABT
RCVCKQ:	CALL 	CKQUIT
	JZ 	RCVSECT
RCVSABT: CALL 	CLOSFIL
	CALL 	ERXIT
	DB 	'++ UNABLE TO RECEIVE BLOCK -- ABORTING ++',CR,LF,BELL,'$'

RCVSTOT: LDA 	VSEEFLG
	ORA 	A
	JZ 	RCVSPT
	LDA 	QFLG
	ORA 	A
	JZ 	RCVSERR
RCVSPT:	CALL 	ILPRT
        DB 	'++ TIMEOUT ++ ',0
RCVPRN:	LDA 	ERRCT
	CALL 	HEXO
	CALL 	CRLF
	JMP 	RCVSERR

RCVSOH:	MVI 	B,1
	CALL 	RECV
	JC 	RCVSTOT
	MOV 	D,A
	MVI 	B,1
	CALL 	RECV
	JC 	RCVSTOT
	CMA
	CMP 	D
	JZ 	RCVDATA
	LDA 	VSEEFLG
	ORA 	A
	JZ 	RCVBSE
	LDA 	QFLG
	ORA 	A
	JZ 	RCVSERR
RCVBSE:	CALL 	ILPRT
        DB 	'++ BAD SECTOR # IN HDR ++',CR,LF,BELL,0
	JMP 	RCVSERR

RCVDATA: MOV 	A,D
	STA 	RCVSNO
	MVI 	A,1
	STA 	DATAFLG
	MVI 	C,0
	LXI 	H,80H

RCVCHR:	MVI 	B,1
	CALL 	RECV
	JC 	RCVSTOT
	MOV 	M,A
	INR 	L
	JNZ 	RCVCHR
	MOV 	D,C
	XRA 	A
	STA 	DATAFLG
	MVI 	B,1
	CALL 	RECV
	JC 	RCVSTOT
	CMP 	D
	JNZ 	RCVCERR
	LDA 	RCVSNO
	MOV 	B,A
	LDA 	SECTNO
	CMP 	B
	JZ 	RECVACK
	INR 	A
	CMP 	B
	JNZ 	ABORT
	RET

RCVCERR: LDA 	VSEEFLG
	ORA 	A
	JZ 	RCVCPR
	LDA 	QFLG
	ORA 	A
	JZ 	RCVSERR
RCVCPR:	CALL 	ILPRT
        DB 	'++ CKSUM ++',0
	JMP 	RCVPRN

RECVACK: CALL 	SENDACK
	JMP 	RCVSECT

SENDACK: MVI 	A,ACK
	CALL 	SEND
	RET

SENDHDR: LDA 	QFLG
	ORA 	A
	JZ 	SENDHNM
	CALL 	ILPRT
        DB 	'SEND # ',0
	LDA 	SECTNO
	CALL 	HEXO
	CALL 	CRLF
SENDHNM: MVI 	A,SOH
	CALL 	SEND
	LDA 	SECTNO
	CALL 	SEND
	LDA 	SECTNO
	CMA
	CALL 	SEND
	RET

SENDSEC: MVI 	A,1
	STA 	DATAFLG
	MVI 	C,0
	LXI 	H,80H
SENDC:	MOV 	A,M
	CALL 	SEND
	INR 	L
	JNZ 	SENDC
	XRA 	A
	STA 	DATAFLG
	RET

SENDCKS: MOV 	A,C
	CALL 	SEND
	MOV	A,0	;SEND NULLS
	CALL	SEND	
	MOV	A,0
	CALL	SEND
	RET

GETACK:	MVI 	B,7		;10 IN ORIG PROG
	CALL 	RECVDG
	JC 	GETATOT
	CPI 	ACK
	RZ
	CPI 	CAN
	JZ 	ABORT
	MOV 	B,A
	LDA 	QFLG
	ORA 	A
	JZ 	ACKERR
	MOV 	A,B
	CALL 	HEXO
	CALL 	ILPRT
        DB 	'H RCD, NOT ACK',CR,LF,0
ACKERR:	LDA 	ERRCT
	INR 	A
	STA 	ERRCT
	CPI 	ERRLIM
	RC
	LDA 	VSEEFLG
	ORA 	A
	JZ 	GACKV
	LDA 	QFLG
	ORA 	A
	JZ 	CSABORT
GACKV:	CALL 	CKQUIT
	STC
	RZ
CSABORT: CALL 	ERXIT
	DB 	'CAN''T SEND SECTOR -- ABORTING',CR,LF,'$'

GETATOT: LDA 	QFLG
	ORA 	A
	JZ 	ACKERR
	CALL 	ILPRT
        DB 	'TIMEOUT ON ACK',CR,LF,0
	JMP 	ACKERR

CKABORT: LDA 	VSEEFLG
	ORA 	A
	JZ 	CKABGO
	LDA 	QFLG
	ORA 	A
	RZ
CKABGO:	CALL 	STAT
	RZ
	CALL 	KEYIN
	CPI 	CAN
	RNZ

ABORT:	LXI 	SP,STACK
ABORTL:	MVI 	B,1
	CALL 	RECV
	JNC 	ABORTL
	MVI 	A,CAN
	CALL 	SEND
ABORTW:	MVI 	B,1
	CALL 	RECV
	JNC 	ABORTW
	MVI 	A,' '
	CALL 	SEND
	CALL 	ILPRT
        DB 	'ROUTINE CANCELLED',CR,LF,BELL,0
	MVI 	A,'B'		;TURN MULTI-FILE MODE..
	STA 	BATCHFLG	;..OFF SO ROUTINE ENDS.
	JMP 	DONETCE

INCRSNO: LDA 	SECTNO
	INR 	A
	STA 	SECTNO
	RET

ERASFIL: LDA 	BATCHFLG	;DON'T ASK FOR ERASE..
	ORA 	A		;..IN MULTI-FILE MODE,..
	JZ 	NOASK		;..JUST DO IT.
	LXI 	D,FCB
	MVI 	C,SRCHF
	CALL 	BDOS
	INR 	A
	RZ
	CALL 	ILPRT
        DB 	'FILES EXISTS -- TYPE ''Y'' TO ERASE: ',BELL,0
	CALL 	KEYIN
	PUSH 	PSW
	CALL 	TYPE
	POP 	PSW
	CALL 	UCASE
	CPI 	'Y'
	JNZ 	MENU
	CALL 	CRLF

NOASK:	LXI 	D,FCB
	MVI 	C,ERASE
	CALL 	BDOS
	RET

BLKFILE: CALL 	ILPRT	;ROUTINE IF NO FILE IS NAMED FOR "SEND" OR "RECEIVE"
	DB 	CR,LF,'No file specified',CR,LF,BELL,0
	JMP 	MENU

MAKEFIL: LXI 	D,FCB
	MVI 	C,MAKE
	CALL 	BDOS
	INR 	A
	RNZ
	CALL 	ERXIT
	DB 	'ERROR - CAN''T MAKE FILE',CR,LF,BELL
	DB 	'DIRECTORY MUST BE FULL',CR,LF,'$'

OPENFIL: LXI 	D,FCB
	MVI 	C,OPEN
	CALL 	BDOS
	INR 	A
	JNZ 	OPENOK
	CALL 	ERXIT
	DB 	'CAN''T OPEN FILE$'

OPENOK:	LDA 	BATCHFLG
	ORA 	A
	JNZ 	OPENOK1
	LDA 	QFLG
	ORA 	A
	RZ
OPENOK1: CALL 	ILPRT
        DB 	'FILE OPEN - EXTENT LENGTH: ',0
	LDA 	FCB+15
	CALL 	HEXO
	MVI 	A,'H'
	CALL 	TYPE
	CALL 	CRLF
	RET

CLOSFIL: LXI 	D,FCB
	MVI 	C,CLOSE
	CALL 	BDOS
	INR 	A
	RNZ
	CALL 	ERXIT
	DB 	'CAN''T CLOSE FILE$'

RDSECT:	LDA 	SECINBF
	DCR 	A
	STA 	SECINBF
	JM 	RDBLOCK
	LHLD 	SECPTR
	LXI 	D,80H
	CALL 	MOVE128
	SHLD 	SECPTR
	RET

RDBLOCK: LDA 	EOFLG
	CPI 	1
	STC
	RZ
	MVI 	C,0
	LXI 	D,DBUF
RDSECLP: PUSH 	B
	PUSH 	D
	MVI 	C,STDMA
	CALL 	BDOS
	LXI 	D,FCB
	MVI 	C,READ
	CALL 	BDOS
	POP 	D
	POP 	B
	ORA 	A
	JZ 	RDSECOK
	DCR 	A
	JZ 	REOF
	CALL 	ERXIT
	DB 	'++ FILE READ ERROR ++$'

RDSECOK: LXI 	H,80H
	DAD 	D
	XCHG
	INR 	C
	MOV 	A,C
	CPI 	16
	JZ 	RDBFULL
	JMP 	RDSECLP

REOF:	MVI 	A,1
	STA 	EOFLG
	MOV 	A,C

RDBFULL: STA 	SECINBF
	LXI 	H,DBUF
	SHLD 	SECPTR
	LXI 	D,80H
	MVI 	C,STDMA
	CALL 	BDOS
	JMP 	RDSECT

WRSECT:	LHLD 	SECPTR
	XCHG
	LXI 	H,80H
	CALL 	MOVE128
	XCHG
	SHLD 	SECPTR
	LDA 	SECINBF
	INR 	A
	STA 	SECINBF
	CPI 	16
	RNZ

WRBLOCK: LDA 	SECINBF
	ORA 	A
	RZ
	MOV 	C,A
	LXI 	D,DBUF
DKWRLP:	PUSH 	H
	PUSH 	D
	PUSH 	B
	MVI 	C,STDMA
	CALL 	BDOS
	LXI 	D,FCB
	MVI 	C,WRITE
	CALL 	BDOS
	POP 	B
	POP 	D
	POP 	H
	ORA 	A
	JNZ 	WRERR
	LXI 	H,80H
	DAD 	D
	XCHG
	DCR 	C
	JNZ 	DKWRLP
	XRA 	A
	STA 	SECINBF
	LXI 	H,DBUF
	SHLD 	SECPTR
	RET

WRERR:	MVI 	C,CAN
	CALL 	SEND
	CALL 	ERXIT
	DB 	'ERROR WRITING FILE',CR,LF,'$'

RECVDG	EQU 	$
	CALL 	IN$MODDATP
	CALL 	IN$MODDATP

RECV:	PUSH 	D

	LDA 	FASTCLK
	ORA 	A
	JZ 	MSEC
	MOV 	A,B
	ADD 	A
	MOV 	B,A

MSEC:	LXI 	D,15000		;60% OF ORIG 50000
	CALL 	CKABORT
MWTI:	CALL 	IN$MODlsr
	CALL 	ANI$MODRCVB
	CALL 	CPI$MODRCVR
	JZ 	MCHAR
	IN	MODLSR
	ANI	038H
	JZ	MWTI2
	IN	MODDATP
	IN	MODMCR
	ORI	010H
	OUT	MODMCR
MWTI2:	DCR 	E
	JNZ 	MWTI
	DCR 	D
	JNZ 	MWTI
	DCR 	B
	JNZ 	MSEC
	POP 	D
	STC
	RET

MCHAR:	CALL 	IN$MODDATP
	POP 	D
	PUSH 	PSW
	ADD 	C
	MOV 	C,A
	LDA 	RSEEFLG
	ORA 	A
	JZ 	MONIN
	LDA 	VSEEFLG
	ORA 	A
	JNZ 	NOMONIN
	LDA 	DATAFLG
	ORA 	A
	JZ 	NOMONIN
MONIN:	POP 	PSW
	PUSH 	PSW
	CALL 	SHOW
NOMONIN: POP 	PSW
	ORA 	A
	RET

SEND:	PUSH 	PSW
	LDA 	SSEEFLG
	ORA 	A
	JZ 	MONOUT
	LDA 	VSEEFLG
	ORA 	A
	JNZ 	NOMONOT
	LDA 	DATAFLG
	ORA 	A
	JZ 	NOMONOT
MONOUT:	POP 	PSW
	PUSH 	PSW
	CALL 	SHOW
NOMONOT: POP 	PSW
	PUSH 	PSW
	ADD 	C
	MOV 	C,A
SENDW:	CALL 	IN$MODlsr
	CALL 	ANI$MODSNDB
	CALL 	CPI$MODSNDR
	JNZ 	SENDW
	POP 	PSW
	CALL 	OUT$MODDATP
	RET

WAITNAK: LDA 	VSEEFLG
	ORA 	A
	JZ 	WAITNPR
	LDA 	QFLG
	ORA 	A
	JZ 	WAITNLP
WAITNPR: CALL 	ILPRT
        DB 	'AWAITING INITIAL NAK',CR,LF,0
WAITNLP: CALL 	CKABORT
	MVI 	B,1
	CALL 	RECV
	CPI 	NAK
	RZ
	CPI 	CAN
	JZ 	ABORT
	DCR 	E
	JZ 	ABORT
	JMP 	WAITNLP

INITADR:
	LHLD 	1
	LXI 	D,3
	DAD 	D
	SHLD 	VSTAT+1
	DAD 	D
	SHLD 	VKEYIN+1
	DAD 	D
	SHLD 	VTYPE+1
	RET

PROCOPT:
	LXI 	D,FCB+1
	LDAX 	D
	STA 	OPTION
OPTLP:	INX 	D
	LDAX 	D
	CPI 	' '
	JZ 	ENDOPT
	LXI 	H,OPTBL
	MVI 	B,OPTBE-OPTBL
OPTCK:	CMP 	M
	JNZ 	OPTNO
	MVI 	M,0
	JMP 	OPTLP

OPTNO:	INX 	H
	DCR 	B
	JNZ 	OPTCK
	JMP 	BADOPT

ENDOPT:	LDA 	VSEEFLG
	ORA 	A
	RNZ
	STA 	QFLG
	RET

DONE:	LDA 	BATCHFLG
	ORA 	A
	JNZ 	DONETCC
	LDA 	QFLG
	ORA 	A
	JZ 	NMSTRNS
	LXI 	H,FCB+1			;PUT FILE NAME IN..
	LXI 	D,FTRNMSG		;..SPACES IN MESSAGE..
	MVI 	B,8			;..BELOW.
	CALL 	MOVE
	INX 	D			;PUT FILE TYPE AFTER..
	MVI 	B,3			;..SKIPPING ONE SPACE..
	CALL 	MOVE			;..BELOW.	
	CALL 	ILPRT
FTRNMSG: DB '              TRANSFERRED',CR,LF,LF,0	;13 SPACES

NMSTRNS: LDA 	FCB		;SAVE DRIVE NO.
	STA 	DISKNO
	LXI 	H,FCB		;BLANK OUT FILE CONTROL BLOCKS
	CALL 	INITFCBS
	LDA 	DISKNO		;PUT DRIVE NUMBER BACK
	STA 	FCB
	LXI 	H,RESTSN	;RESTORE SECTORE NUMBERS..
	LXI 	D,SECTNOB	;..FOR NEW FILE TRANSFER.
	MVI 	B,SECTNOE-SECTNOB  ;ROUTINE ALSO DONE IN MENU.
	CALL 	MOVE
	LDA 	SENDFLG		;GOES TO EITHER SEND OR..
	ORA 	A		;..RECEIVE FILE, DEPENDING..
	JNZ 	SENDFIL		;..UPON WHICH ROUTINE SET..
	JMP 	RCVFIL		;..THE FLAG IN MULTI-FILE MODE.

DONETCC: MVI 	A,TRUE		;INDICATE NO FILES BEING..
	STA 	FSTFLG		;RESET MULTIFILE TRANS
	STA 	NFILFLG		;..USED IN TERMINAL ROUTINE.
	CMA
	STA 	SAVEFLG		;STOP MEMORY SAVE IN TERM ROUTINE.
	LDA 	VSEEFLG
	ORA 	A
	JZ 	DONETC
	LDA 	QFLG
	ORA 	A
	JZ 	donetce
DONETC:	CALL 	ILPRT
        DB  	CR,LF,'ALL TRANSFERS COMPLETED'
	DB 	CR,LF,BELL,0

DONETCE: LDA 	TERMFLG		;SEE IF RETURN TO..
	ORA 	A		;..TERMINAL MODE..
	JNZ 	MENU		;..AFTER X'FER.
	CALL 	CRLF
	JMP 	TERM

INITMOD: LXI	H,180h		;Default to 300 baud, H=01 (MS), L=80 (LS)
	JMP	I2661

INITM:	PUSH	B		; what was in the B/C
	POP	H		; .. is now in the H/L
I2661:	PUSH	B		;
	PUSH	D		;
;
;  Fixes selected (^B) baud rate in memory if different than default.	** TA
;									**  |
	SHLD	INITMOD+1	; store baud for LXI H instruction
;
;	LS and MS bits of baud refer to 8250 type UART which are used
;	here only as a referance point for program indexing. They are
;	 not a part of the code used to set up the 2661-2 EPCI.		**  |
;									** TA
	XCHG			; swap D/E with H/L.. E = LS bits of baud
	LXI	H,TEPBD		;BAUD RATE CONVERSATION TABLE
	XRA	A		; zero A
	MOV	C,A		; zero C
	MOV	A,E		; move LS bits of baud to A
INIT1:	CMP	M		; compare to table
	JZ	INIT2		; found it in table
	INR	C		; count number of trys (position in table 0-15)
	INX	H		; get next address in table
	JMP	INIT1		; go look at it

INIT2:	MOV	A,D		; move MS bits of baud to A
	ANI	06H		; is it less than 300 baud		** TA
	JZ	INIT3		; .. no
	MVI	A,MR1$2SB	; .. yes, so 2 stop bits to A
	JMP	INIT4		; 

INIT3:	MVI	A,MR1$1SB	; add 40H (1 Stop Bit) to A
INIT4:	ADI	MR1$8BW+MR1$A1X	; add 0CH (8 Bits) + 01H (Async 1X Clock) to A
	OUT	EP$BAS+EP$MR2	; send to port 0EEH (Mode Register 2)
	MVI	A,30H		; set the A to 30H
	ORA	C		; combine the position in the table with A 
;				; 110/C=3, 300/C=6H, 1200/C=8H, 9600/C=DH
	OUT	EP$BAS+EP$MR2	; send it to port 0EEH (Mode Register 2)
	MVI	A,CR$NML+CR$RTS+CR$RXEN+CR$DTR+CR$TXEN
	OUT	EP$BAS+EP$CR
	POP	D
	POP	B
	RET
;
;  EPBAUD -- BAUD RATE TABLE FOR 2661-2        "C"   *=not supported	** TA
;									**  |
TEPBD:	DB	0FFH		;45.5		0	*
	DB	0FFH		;50		1	*
	DB	0FFH		;75		2	*
	DB	017H		;110		3
	DB	0FFH		;134.5		4	*
	DB	0FFH		;150		5	*
	DB	080H		;300		6
	DB	0C0H		;600		7
	DB	060H		;1200		8
	DB	0FFH		;1800		9	*
	DB	0FFH		;2000		10	*
	DB	030H		;2400		11
	DB	018H		;4800		12
	DB	00CH		;9600		13
	DB	006H		;19200		14			**  |
	DB	002H		;38400		15			** TA
;
;
delay:	lxi	b,10000
delay1:	dcx	b
	mov	a,b
	ora	c
	jnz	delay1
	ret

SETBAUD: CALL 	GETBAUD		;..ROUTINE RETURNS WITH CHANGE..
	call	initm		;Go set the new rate
	ret

GETBAUD: LXI	b,180h		;					** TA
	LDA 	FCB+9		;					**  |
	CPI	'1'		;110, 1200, 19200 baud
	JZ	ONEZY
	CPI	'3'		;300, 38400 baud
	JZ	THREEZY
	CPI	'6'		;600 baud
	LXI	b,0C0H
	RZ
	CPI	'2'		;2400 baud
	LXI	B,030H
	RZ
	CPI	'4'		;4800 baud
	LXI	B,018H
	RZ
	CPI	'9'		;9600 baud
	LXI	B,00CH
	RZ
	JMP	OUTZY

ONEZY:	LDA	FCB+10
	CPI	'1'		;110 baud
	LXI	B,417H
	RZ
	CPI	'2'		;1200 baud
	LXI	B,060H
	RZ
	CPI	'9'		;19200 baud
	LXI	B,006H
	RZ
	JMP	OUTZY

THREEZY: LDA	FCB+10 
	CPI	'0'		;300 baud
	LXI	b,180H
	RZ
	CPI	'8'		;38400 baud
	LXI	B,002H
	RZ
OUTZY:	CALL	ILPRT
	DB	CR,LF
	DB	'++ INVALID BAUD RATE ++   Baud Rate defaults to 300'
	DB	CR,LF,LF,BELL,0
	LXI	B,180H		; default is 300 baud			**  |
	RET			;					** TA
;
;BADRATE: CALL 	ERXIT							** ??
;	DB 	'++ INVALID BAUD RATE ++$'				** ??
;
MOVEFCB: LXI 	H,FCB+16
	LXI 	D,FCB
	MVI 	B,16
	CALL 	MOVE
	XRA 	A
	STA 	FCBSNO
	STA 	FCBEXT
	RET

SHOW:	CPI 	LF
	JZ 	CTYPE
	CPI 	CR
	JZ 	CTYPE
	CPI 	9
	JZ 	CTYPE
	CPI 	' '
	JC 	SHOWHEX
	CPI 	7FH
	JC 	CTYPE
SHOWHEX: PUSH 	PSW
	MVI 	A,'('
	CALL 	CTYPE
	POP 	PSW
	CALL 	HEXO
	MVI 	A,')'
	JMP 	CTYPE

CTYPE:	PUSH 	B
	PUSH 	D
	PUSH 	H
	MOV 	E,A
	MVI 	C,WRCON
	CALL 	BDOS
	POP 	H
	POP 	D
	POP 	B
	RET

CRLF:	PUSH 	PSW
	MVI 	A,CR
	CALL 	TYPE
	MVI 	A,LF
	CALL 	TYPE
	POP 	PSW
	RET

TYPE:	PUSH 	PSW
	PUSH 	B
	PUSH 	D
	PUSH 	H
	MOV 	C,A
VTYPE:	CALL 	$-$
	POP 	H
	POP 	D
	POP 	B
	POP 	PSW
	RET

STAT:	PUSH 	B
	PUSH 	D
	PUSH 	H
VSTAT:	CALL 	$-$
	POP 	H
	POP 	D
	POP 	B
	ORA 	A
	RET

KEYIN:	PUSH 	B
	PUSH 	D
	PUSH 	H
VKEYIN:	CALL 	$-$
	POP 	H
	POP 	D
	POP 	B
	RET

UCASE:	CPI 	61H		;CHANGES LOWER CASE CHARACTER..
	RC			;..IN A-REG TO UPPER CASE.
	CPI 	7BH
	RNC
	ANI 	5FH
	RET

HEXO:	PUSH 	PSW
	RAR
	RAR
	RAR
	RAR
	CALL 	NIBBL
	POP 	PSW
NIBBL:	ANI 	0FH
	CPI 	10
	JC 	ISNUM
	ADI 	7
ISNUM:	ADI 	'0'
	JMP 	TYPE

;RETURNS W/ ZERO SET IF RETRY ASKED. IF MULTI-FILE MODE, THEN
;NO QUESTIONS ASKED, JUST QUIT

CKQUIT:	LDA 	BATCHFLG
	ORA 	A
	JNZ 	CKQTASK		;ASK FOR RETRY
	INR 	A		;RESET ZERO FLG
	RET

CKQTASK: XRA 	A
	STA 	ERRCT
	CALL 	ILPRT
        DB 	'MULTIPLE ERRORS ENCOUNTERED.',CR,LF
        DB 	'TYPE Q TO QUIT, R TO RETRY:  ',BELL,0
	CALL 	KEYIN
	PUSH 	PSW
	CALL 	CRLF
	POP 	PSW
	CALL 	UCASE		;INSTEAD OF "ANI 5FH"
	CPI 	'R'
	RZ
	CPI 	'Q'
	JNZ 	CKQUIT
	ORA 	A
	RET

ILPRT:	XTHL
ILPLP:	MOV 	A,M
	ORA 	A
	JZ 	ILPRET
	CALL 	CTYPE
	INX 	H
	JMP 	ILPLP

ILPRET:	XTHL
	RET

PRTMSG:	MVI 	C,PRINT
	JMP 	BDOS

ERXIT:	POP 	D
	CALL 	PRTMSG
	CALL 	ILPRT
	DB 	BELL,0
	LDA 	BATCHFLG
	ORA 	A
	JNZ 	DONETCE
	MVI 	A,'Q'		;RESET QFLG
	STA 	QFLG
	JMP 	ABORT		;ABORT OTHER COMPUTER

EXIT:	LXI 	D,80H
	MVI 	C,STDMA
	CALL 	BDOS
	JMP 	0

MOVE128: MVI 	B,128
MOVE:	MOV 	A,M
	STAX 	D
	INX 	H
	INX 	D
	DCR 	B
	JNZ 	MOVE
	RET

;INITIALIZES CP/M FILE CONTROL BLOCKS AT 5CH AND 6CH

SETFCB:	LXI 	D,CMDBUF
	LXI 	H,FCB
	CALL 	CPMLINE
	CALL 	PROCOPT

CHECKNM: LDA 	FCB+1		;CHECK ON THE PRIMARY OPTION
	CPI 	'E'		;RETURN IF ECHO OPTION
	RZ
	CPI 	'M'		;RETURN TO MENU
	RZ
	MOV 	B,A
	LDA 	PMMIBYTE
	ORA 	A
	MOV 	A,B
	JZ 	S4
	CPI 	'C'
	RZ
S4:	CPI 	'T'
	JZ 	TERMSEL
	CPI 	'S'
	JZ 	CKFILE
	CPI 	'R'
	JNZ 	BDOPT
	LDA 	BATCHFLG	;IF MULT FILE MODE, THEN..
	ORA 	A		;..RECV OPT DOES NOT NEED..
	RZ			;..NAME.
	JMP 	CKFILE

BDOPT:	CALL 	ILPRT
	DB 	CR,LF,'++ Bad Option ++',CR,LF,BELL,0
	JMP 	REENT

CKFILE:	LDA 	FCB+17		;IF OPTION THAT NEEDS FILE NAME,..
	CPI 	' '		;..THEN CHECK TO SEE IF NAME..
	RNZ			;..EXISTS. IF NOT..
REENT:	CALL 	ILPRT		;..DO EVERYTHING OVER.
        DB 	CR,LF,'Re-enter PRIMARY option and file name only: ',BELL,0
	LXI 	D,CMDBUF
	CALL 	INBUFF
	JMP 	SETFCB

TERMSEL: LDA 	FCB+17
	CPI 	' '
	JNZ 	SAVAGN
	MVI 	A,FALSE
	STA 	SAVEFLG
	MVI 	A,TRUE
	STA 	NFILFLG
	CMA
;	OUT 	FRONTPAN						** ??
	RET

SAVAGN:	MVI 	A,FALSE
	STA 	NFILFLG
	RET

NEWBAUD: CALL 	ILPRT		;				(4) ** TA
	DB	CR,LF,LF
	DB	'Valid baudrates are: 110, 300, 600, 1200, '
	DB	'2400, 4800, 9600, 19200 and 38400.'
	DB	CR,LF
	DB 	'Enter New Baudrate: ',0

	LXI 	H,FCB+9		;
	MVI 	M,0		;PUTS A ZERO IN FIRST POSITION SO AS TO
LOOP5:	call	stat
	jz	loop5
	CALL 	KEYIN		;FORCE THE DEFAULT OPTION OF 300 BAUD.
	CPI 	CR		;CARRIAGE RET ENTERS BAUD RATE
	JNZ 	CONNEWB		;GOES TO THE ESTABLISHED ROUTINE - RETURN TO MAIN
	CALL 	CRLF		;PROGRAM IS DONE THERE.
	JMP 	SETBAUD

CONNEWB: CPI 	30H		;MAKE SURE IT'S..
	JC 	LOOP5		;..A DIGIT, ELSE..
	CPI 	3AH		;..DON'T ACCEPT IT.
	JNC 	LOOP5
	MOV 	M,A
	MOV 	C,A
	CALL 	TYPE		;ECHO THE CHARACTER ENTERED
	INX 	H
	JMP 	LOOP5

MENU:	LXI 	H,RESTSN	;RESTORE SECTORE NUMBERS..
	LXI 	D,SECTNOB	;..FOR NEW FILE TRANSFER.
	MVI 	B,SECTNOE-SECTNOB
	CALL 	MOVE
	LXI 	H,RESTROPT	;RESTORE OPTION TABLE
	LXI 	D,OPTBL
	MVI 	B,OPTBE-OPTBL
	CALL 	MOVE
	MVI 	A,0
	STA 	MFFLG1		;RESET MFACCESS ROUTINE..
	CMA			;..AND MULTI TRANS IN CASE..
	STA 	FSTFLG		;..OF ABORT.

MENU1:	LDA 	XPRFLG		;TEST IF MENU SHOULD BE SHOWN
	ORA 	A
	JNZ 	XPRT
	CALL 	ILPRT
	DB 	CR,LF,LF
	DB 	'XPR  - Toggle expert mode (Menu on/off)',CR,LF
	DB 	'DIR  - List directory (may specify drive)',CR,LF
	DB 	'CPM  - Exit to CP/M',CR,LF,LF
	DB	'------------------- FILE TRANSFER MODE -------------------',CR,LF
	DB 	'S    - Send CP/M file using protocol.           ^X cancels',CR,LF
	DB 	'R    - Receive CP/M file using protocol.',CR,LF,LF
	DB	'--------------- TERMINAL CONVERSATION MODE ---------------',CR,LF
	DB 	'WRT  - Write save file to disk and close it.',CR,LF
	DB 	'DEL  - Erase save file and abort save.',CR,LF
	DB	'RET  - Return to terminal mode.',cr,lf
	DB 	'T    - No echo Conversation mode (optional save file name)',CR,LF
	DB 	'E    - Echo Conversation mode (optional save file name)',CR,LF
	DB	'       ^Y toggle save to file (":" indicates on)',CR,LF
	DB	'       ^B change baud rate       ^T transfer file',CR,LF
	DB	'       ^E return to menu         ^X cancel transfer',0
;
XPRT:	CALL 	ILPRT
	DB 	CR,LF,LF,'DEFAULT DRIVE: ',0
	MVI 	C,25		;CURRENT DISK FUNCTION
	CALL 	BDOS
	ADI 	41H		;MAKE ASCII
	CALL 	TYPE
	CALL 	ILPRT
	DB 	CR,LF,LF,'Command: '
	DB 	0

GETCMD:	LXI 	D,CMDBUF	;ENTER COMMAND
	CALL 	INBUFF
	CALL 	CRLF
	LXI 	D,CMDBUF+2	;POINT TO COMMAND
	CALL 	ILCOMP
	DB 	'CPM',0
	JNC 	EXIT
	CALL 	ILCOMP
	DB 	'DIR',0
	JNC 	DIR
	CALL 	ILCOMP
	DB 	'RET',0
	JC 	NXTOPT1		;CARRY SET = NO MATCH
	LHLD 	HLSAVE		;RETURN TO TERMINAL..
	JMP 	TERM		;..MODE WITH SAVE OPTION..
				;..IF PREVIOUSLY ENABLED.
NXTOPT1:
	CALL 	ILCOMP
	DB 	'WRT',0
	JNC 	WRTFIL
	CALL 	ILCOMP
	DB 	'XPR',0
	JNC 	XPRMODE
	CALL 	ILCOMP
	DB 	'DEL',0
	JNC 	NEWFILE
	LDA 	PMMIBYTE
	ORA 	A
	JZ 	NXTOPT2
	CALL 	ILCOMP
	DB 	'CAL',0
	JC 	NXTOPT2
	MVI 	A,1		;FORCE 1 IN CHAR COUNT OF..
	STA 	CMDBUF+1	;..CMDBUF SO THAT IT ONLY..
	JMP 	DOOPT		;..LOOKS AT 'C' FOR DIAL

NXTOPT2: PUSH 	H
	LDA 	CMDBUF+2
	LXI 	H,COMPLIST
	CALL 	COMPARE		;COMPARES LIST POINTED TO BY HL..
	POP 	H		;..TO CHAR IN A-REG.
	JC 	MENU1		;CARRY SET = NO MATCH

DOOPT:	PUSH 	H		;LOAD ORIGINAL FCB WITH TRANSFER..
	CALL 	SETFCB		;..CMDS AND GO TO BEGINNING OF..
	POP 	H		;..PROGRAM. WILL FOLLOW SAME LOGIC..
	JMP 	RESTART		;..AS IF PROGRAM WERE CALLED WITH..
				;..CP/M COMMAND LINE.

DIR:	CALL 	DIRLST
	JMP 	XPRT

NEWFILE: LDA 	FCB3+1
	CPI 	' '
	JZ 	MENU1		;IF NO FILE, DON'T ERASE
	LXI 	D,FCB3
	MVI 	C,ERASE
	CALL 	BDOSRT
	MVI 	A,TRUE		;DO NOT ALLOW TERMINAL..
	STA 	NFILFLG		;..SAVE SINCE NO FILE..
	CMA			;..SPECIFIED.
	STA 	SAVEFLG
	LXI 	H,FCB3
	CALL 	INITFCBS
	JMP 	MENU1

WRTFIL:	LDA 	NFILFLG
	CPI 	TRUE
	JZ 	MENU1
	LDA 	FCB3+1		;CHECK THAT FILE WAS REQUESTED
	CPI 	' '
	JZ 	MENU1
	LHLD 	HLSAVE
	CALL 	NUMRECS		;DISK WRITE ROUTINE AS USED IN..
	CALL 	WRTDSK		;..IN THE INTDSKSV ROUTINE.
	CALL 	CLOSE3
	MVI 	A,TRUE
	STA 	NFILFLG
	CMA
	STA 	SAVEFLG
	LXI 	H,FCB3
	CALL 	INITFCBS	;BLANK OUT FCB SO WRITTEN FILE..
	JMP 	MENU1	;..CAN'T BE ERASED.

XPRMODE: LDA	 XPRFLG
	CMA
	STA 	XPRFLG
	JMP 	MENU1

COMPARE: MOV 	B,M		;COMPARES A-REG WITH LIST..
COMPLP:	INX 	H		;..ADDRESSED BY HL. FIRST ELEMENT..
	CMP 	M		;..OF LIST MUST BE NUMBER OF ELEMENTS..
	JZ 	VALID		;..BEING COMPARED. RETURNS WITH..
	DCR 	B		;..CARRY SET IF A-REG DOES NOT..
	JNZ 	COMPLP		;.. CONTAIN AN ELEMENT IN LIST.
	STC
VALID:	RET

COMPLIST: DB 	4, 'S', 'R', 'T', 'E'

ILCOMP:	INLNCOMP		;A MACRO IN MACROS.LIB


INBUFF:	INBUF			;A MACRO IN "MACROS.LIB"

;IF ABOVE ROUTINE DOES NOT LET YOU EDIT IN A PROPER MANNER,
;THEN THE MACRO MAY BE SUBSTITUTED FOR THE FOLLOWING ROUTINE:

;INBUFF	MVI C,RDBUF
;	CALL BDOSRT
;	RET			;BUT BE CAREFUL OF CONTROL-C


CPMLINE: CMDLINE		;A MACRO IN "MACROS.LIB"

DIRLST:	DIRLIST			;A MACRO IN "MACROS.LIB"

NFILFLG: DB 	FALSE		;NORMALLY SET TO FALSE. ALLOWS WRITE TO..
				;..MEMORY IN TERMINAL MODE.

OPTION:	DB 	0

OPTBL	EQU 	$
ANSWFLG: DB 	'A'
DISCFLG: DB 	'D'
ORIGFLG: DB 	'O'
QFLG:	DB 	'Q'
RSEEFLG: DB 	'R'
SSEEFLG: DB 	'S'
VSEEFLG: DB 	'V'
TERMFLG: DB 	'T'
BATCHFLG: DS 	1	;SET TO 'B' BY MENU. DOES NOT ALLOW MULTI-..
OPTBE	EQU 	$	;..FILE XFER WHEN PROGRAM INITIALLY CALLED.

RESTROPT:		;MUST BE IN SAME ORDER AS TABLE ABOVE

	DB 	'A','D','O','Q','R','S','V','T','B'

RESTSN:	DB 	0,0,0,0
	DW 	DBUF
	DB 	0
	DB 	0

SECTNOB EQU 	$
RCVSNO:	DB 	0
SECTNO:	DB 	0
ERRCT:	DB 	0
EOFLG:	DB 	0
SECPTR:	DW 	DBUF
SECINBF: DB 	0
DATAFLG: DB 	0
SECTNOE	EQU 	$

BADOPT:	CALL 	ILPRT
	DB 	'INVALID OPTION',CR,LF,BELL,0
	JMP 	MENU

FSTFLG:	DB 	TRUE

CMDBUF:	DB 	80H,0
	DS 	80H
;BADLIB:	DB	CR,LF,'++ BAD LIBRARY NUMBER CALLED ++',CR,LF,BELL,'$' ** ??
HLSAVE:	DS 	2
DISKNO:	DS 	1
SENDFLG: DS 	1
NBSAVE:	DS 	2
BGNMS:	DS 	2
FILECT:	DS 	1
NAMECT:	DS 	1

	DS 	40
STACK:	DS 	2
FCB3:	DS 	33
FCBBUF:	DS 	15
DBUF:	DS 	16*128		;16 SECTOR DISK BUFFER
NAMEBUF: DS 	1		;BUFFER FOR NAMES IN BATCH MODE. OVERFLOWS..
				;..ABOVE PROGRAM CODE.
;	BDOS EQUATES

RDCON	EQU 	1
WRCON	EQU 	2
PRINT	EQU 	9
RDBUF	EQU 	10
CONST	EQU 	11
OPEN	EQU 	15
CLOSE	EQU 	16
SRCHF	EQU 	17
SRCHN	EQU 	18
ERASE	EQU 	19
READ	EQU 	20
WRITE	EQU 	21
MAKE	EQU 	22
REN	EQU 	23
STDMA	EQU 	26
BDOS	EQU 	5
REIPL	EQU 	0
FCB	EQU 	5CH
FCBEXT	EQU 	FCB+12
FCBSNO	EQU 	FCB+32
FCBRNO	EQU 	FCB+32
FCB2	EQU 	6CH

LAST	END 	100H