;		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.

;LAST 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.

TRUE	EQU 0FFH
FALSE	EQU 0

; PMMI EQUATES

PORT	EQU 0E0H		;PMMI BASE ADDRESS

MODCTLP	EQU PORT		;MODEM CONTROL PORT
MODSNDB	EQU 1			;MODEM SEND BIT (XMIT BUFF EMPTY)
MODSNDR	EQU 1			;MODEM SEND READY
MODRCVB	EQU 2			;MODEM RECEIVE BIT (DAV)
MODRCVR	EQU 2			;MODEM RECEIVE READY
MODDATP	EQU PORT+1		;MODEM DATA PORT
BAUDRP	EQU PORT+2		;BAUD RATE PORT
MODCTL2	EQU PORT+3		;2ND MODEM CONTROL PORT
ORIGMOD	EQU 1DH			;ORIGINATE MODE
ANSWMOD	EQU 1EH			;ANSWER MODE

WAITCTS	EQU	255	;number of seconds X 10 to wait for computer
			;tone after pmmi auto-dial function, 255 MAX.

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 FALSE		;4 MHz or greater
BAKUPBYTE	DB TRUE 		;true=make .BAK file
XPRFLG		DB TRUE			;true=no menu, false=print menu
PULSERATE	DB 125			;125 FOR 20PPS, 250 FOR 10PPS dialing
IN$MODCTLP	IN  MODCTLP ! RET	;in modem control port
OUT$MODDATP	OUT MODDATP ! RET	;out modem data port
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  MODDATP ! RET	;in modem data port
ANI$MODRCVB	ANI MODRCVB ! RET	;bit to test for receive ready
CPI$MODRCVR	CPI MODRCVR ! RET	;value of receive bit when ready
JMP$INITMOD	JMP INITMOD		;to initialize port, if necessary
OUT$MODCTLP	OUT MODCTLP ! RET	;out modem control port
IN$BAUDRP	IN  BAUDRP  ! RET	;in baudrate port
OUT$BAUDRP	OUT BAUDRP  ! RET	;out baudrate port
OUT$MODCTL2	OUT MODCTL2 ! RET	;out modem control port #2

CRFLAG	DB 0	;CONTINUOUS REDIAL FLAG

; PHONE NUMBER LIBRARY TABLE FOR DIALING FROM LIBRARY
; OF NUMBERS STORED IN THESE DB'S AT ASSEMBLY-TIME.
; EACH DB MUST BE 30 CHARACTERS LONG FOR PROPER OPERATION.
; A 'DB 0' INDICATES NO DIALING, PROGRAM WILL DISCONNECT
; AND RETURN TO COMMAND MODE.  LAST DB MUST BE DB 0. UP TO
; 26 NUMBERS ARE ALLOWED.

;		'----5---10---15---20---25---30'
NUMBLIB	DB	'A=Atlanta CBBS  1-404-394-4220'	;'A'
	DB	'B=Chicago CBBS  1-312-545-8086'	;'B'
	DB	'C=Calamity Clif 1-312-234-9257'	;'C'
	DB	'D=Detroit CP/M* 1-313-588-7054'	;'D'
	DB	'E=                            '	;'E'
	DB	'F=                            '	;'F'
	DB	'G=                            '	;'G'
	DB	'H=                            '	;'H'
	DB	'I=                            '	;'I'
	DB	'J=                            '	;'J'
	DB	'K=                            '	;'K'
	DB	'L=                            '	;'L'
	DB	'M=                            '	;'M'
	DB	'N=                            '	;'N'
	DB	'O=                            '	;'O'
	DB	'P=                            '	;'P'
	DB	'Q=                            '	;'Q'
	DB	'R=                            '	;'R'
	DB	'S=SOURCE/Rockford     398-6090'	;'S'
	DB	'T=                            '	;'T'
	DB	'U=                            '	;'U'
	DB	'V=                            '	;'V'
	DB	'W=                            '	;'W'
	DB	'X=                            '	;'X'
	DB	'Y=                            '	;'Y'
	DB	'Z=                            '	;'Z'
	DB	0					; end

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

	CALL START1

	DB CR,LF,'MODEM7 as of 12/18/80',cr,lf
	DB 'Originally Written by Ward Christensen',cr,lf
	DB 'Revisions by Mark M. Zeiger, Jim Mills',cr,lf,'$'


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

RESTART
	LDA OPTION	;GET MAIN OPTION
	MOV B,A		;SAVE IT
	LDA PMMIBYTE	;PMMI?
	ORA A		;SET FLAGS
	MOV A,B		;GET OPTION BACK
	JZ S1		;NOT PMMI
	CPI 'C'		;CALL (DIAL) FUNCTION?
	JZ DIALPL	;YES, GO TO IT

S1	CPI ' '			;NO OPTION SPEC'D?
	JZ MENU			;TRUE, GO MENU
	CPI 'M'			;MENU ASKED FOR?
	JZ MENU			;YES, GO MENU
	CALL JMP$INITMOD	;
	CALL MOVEFCB
	MVI A,FALSE
	STA NFILFLG

	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?
	JZ DISCON1	;YES, DISCONNECT & GO MENU
	JMP MENU	;NO OPTION SPEC'D, GO MENU

;REVISED TERMINAL ROUTINE ALLOWING MEMORY SAVE

DSKSAVE	LDA NFILFLG	;NEW FILE FLAG
	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
	STA NFILFLG	;
	CMA		; 0
	STA SAVEFLG	;
	OUT FRONTPAN	;0FFH PORT FOR IMSAI FRONT PANEL
	JMP TERM	;

GOODNM	CALL ERASFIL
	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 LINE
	CALL KEYIN	;GET CHAR FROM KBD
	CPI EXITCHR	;^E?
	JZ MENU		;YES, RETURN TO MENU
	CPI DISCCHR	;^D?
	JZ DISCON1	;YES, DISCONNECT & RETURN TO MENU

	CPI TRANCHR	;TEST FOR TRANSFER REQUEST (^T)
	CZ TRANSFER	;SEND-A-FILE (BLIND SEND)
	JZ TERM		;LOOP

	MOV B,A
	LDA PMMIBYTE
	ORA A
	MOV A,B
	JZ S2
	CPI CHGBAUD
	PUSH PSW
	PUSH H
	CZ NEWBAUD
	POP H
	POP PSW
	CPI CHGBAUD	;^B?
	JZ TERML

S2	CPI SAVECHR
	JNZ NOTOG
	LDA NFILFLG	;DO NOT ALLOW SAVE IF..
	CPI TRUE	;..THIS FLAG IS SET.
	JZ TERML
	LDA SAVEFLG
	CMA
	STA SAVEFLG
	JMP TERML

NOTOG	CALL OUT$MODDATP

TERML	CALL IN$MODCTLP
	CALL ANI$MODRCVB
	CALL CPI$MODRCVR
	JNZ TERM
	CALL IN$MODDATP
	CPI 0		;CHECK FOR NULLS
	JZ TERM		;DON'T PROCESS THEM
	ANI 7FH		;STRIP PARITY
	CALL TYPE
	PUSH PSW
	LDA SAVEFLG
	CPI FALSE
	JZ NOSAVE
	POP PSW
	MOV M,A
	INX H
	SHLD HLSAVE	;MENU COMMAND DESTROYS HL-REG..
			;..GET HL WHEN ENTERING VIA 'RET' CMD.
	MOV B,A
	LDA IMSAIBYTE
	ORA A
	MOV A,B
	JZ COLON
	CMA		;FRONT PANEL SHOWS CHARS WHEN..
	OUT FRONTPAN	;..MEMORY SAVE IS ACTIVE.
	JMP NOCOLON
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$MODCTLP
	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,'++FILE DOES NOT EXIST++',CR,LF,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,'++FILE TRANSFER COMPLETED++',CR,LF,BELL,0
	JMP RETURN
RETURNU	CALL ILPRT
        DB CR,LF,'++FILE TRANSFER UNSUCCESSFUL++',CR,LF,BELL,0
	JMP RETURN
TRANCAN	CALL ILPRT
        DB CR,LF,CR,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$MODCTLP
	CALL ANI$MODSNDB
	CALL CPI$MODSNDR
	JNZ MODOUTL
	POP PSW
	CALL OUT$MODDATP
	CALL TYPE
	RET

FCB4	DS 33

;TERMINAL ECHO MODE

TRMECHO	CALL IN$MODCTLP
	CALL ANI$MODRCVB
	CALL CPI$MODRCVR
	JZ LINECHR
	CALL STAT
	JZ TRMECHO
	CALL KEYIN
	CPI EXITCHR
	JZ MENU

	MOV B,A
	LDA PMMIBYTE
	ORA A
	MOV A,B
	JZ S3
	CPI CHGBAUD	;SAME ROUTINE AS IN TERMINAL MODE
	PUSH PSW
	CZ NEWBAUD
	POP PSW
	CPI CHGBAUD

	JZ TRMECHO
S3	CALL OUT$MODDATP
	CALL TYPE
	JMP TRMECHO

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

;UNCOMMENTED LINES ARE THOSE OF ORIGINAL MODEM PROGRAM.
;COMMENTS DENOTE MY ADDITIONS.

;		SEND A CP/M FILE

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

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,'$'

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,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
	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
	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$MODCTLP
	CALL ANI$MODRCVB
	CALL CPI$MODRCVR
	JZ MCHAR
	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$MODCTLP
	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
	LDA PMMIBYTE
	ORA A
	JZ JMP$INITMOD		;RETURN DONE FROM THIS ROUTINE..
	LDA IN$MODCTLP+1	;..IF NOT PMMI
	STA OUT$MODCTLP+1
	INR A
	STA OUT$MODDATP+1
	STA IN$MODDATP+1
	INR A
	STA IN$BAUDRP+1
	STA OUT$BAUDRP+1
	INR A
	STA OUT$MODCTL2+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,CR,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
	OUT FRONTPAN
	STA SAVEFLG		;STOP MEMORY SAVE IN TERM ROUTINE.
	LDA VSEEFLG
	ORA A
	JZ DONETC
	LDA QFLG
	ORA A
	JZ donetca
DONETC	CALL ILPRT
        DB  CR,LF,'ALL TRANSFERS COMPLETED'
	DB CR,LF,BELL,0
donetca	lda	discflg		;see if disconnect when thru
	ora	a
	jnz	donetce		;no, don't disconnect
donetcb	call	ilprt

	db	cr,lf,'++PRESS RETURN TO DISCONNECT++',bell,cr,lf,0

	mvi	c,rdcon
	call	bdos		;wait for response
	cpi	0dh		;carriage return
	jnz	donetcb		;nope

	call	ilprt

	db	cr,lf,'++DISCONNECTED++',cr,lf,0

	call	disconnt	;hang-up the pmmi
	jmp	exit		;go to CP/M

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

INITMOD
SETBAUD	LDA PMMIBYTE
	ORA A
	RZ
	LDA ANSWFLG	;IF ANSWER OR ORIGINATE MODE..
	ORA A		;..IS NOT REQUESTED OR NO..
	JNZ SKIPB1	;..BAUDRATE SPECIFIED, THEN..
	CALL GETBAUD	;..ROUTINE RETURNS WITH CHANGE..
	JMP FIXBAUD	;..OF BAUD. IF OPT REQUESTED,..
SKIPB1	LDA ORIGFLG	;..A BLANK FORCES 300 BAUD..
	ORA A		;..ELSE A 0 FROM NEWBAUD..
	JNZ SKIPB2	;..FORCES 300 BAUD.
	CALL GETBAUD
	JMP FIXBAUD
SKIPB2	LDA FCB+9
	CPI 0		;IF ZERO, NEWBAUD WANTS 300
	JZ SKIPB3
	CPI ' '
	RZ
	JMP SKIPB4
SKIPB3	MVI A,' '	;FORCE 300 BAUD
	STA FCB + 9
SKIPB4	CALL GETBAUD
FIXBAUD	CALL OUT$BAUDRP
	CPI 52
	MVI A,5FH
	JC GT300
	MVI A,7FH
GT300	CALL OUT$MODCTL2

	LDA ORIGFLG
	ORA A
	MVI A,ORIGMOD
	JZ OFFHOOK
	LDA ANSWFLG
	ORA A
	MVI A,ANSWMOD
	RNZ

OFFHOOK	LXI H,4000
OFFDLY	DCR L
	JNZ OFFDLY
	DCR H
	JNZ OFFDLY
	CALL OUT$MODCTLP
	RET

GETBAUD	LDA FCB+9
	CPI ' '
	MVI A,52
	RZ
	LDA FCB+9
	CPI 0
	MVI A,52
	RZ

	LXI D,FCB+9
	LXI H,0
DECLP	LDAX D
	INX D
	CPI ' '
	JZ DECLP
	CPI '0'
	JC BADRATE
	CPI '9'+1
	JNC BADRATE
	SUI '0'

	MOV B,H
	MOV C,L
	DAD H
	DAD H
	DAD B
	DAD H
	ADD L
	MOV L,A
	JNZ DIGNC
	INR H
DIGNC	MOV A,E
	CPI FCB+12
	JNZ DECLP

	MOV A,H
	CMA
	MOV D,A
	MOV A,L
	CMA
	MOV E,A
	INX D
	LXI H,15625
	LXI B,-1
DIVLP	INX B
	DAD D
	JC DIVLP
	MOV A,B
	ORA A
	MOV A,C
	RZ

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

;DIALING ROUTINES TAKEN (AND GREATLY MODIFIED) FROM PMMI MANUAL.

;MODEM CONTROL COMMAND WORDS

CLEAR	EQU 3FH		;IDLE MODE
MAKEM	EQU 1		;TELE LINE MAKE (OFF HOOK)
BRKM	EQU 0		;TELE LINE ON HOOK (BREAK DURING DIALING)
DTMSK	EQU 1		;DIAL TONE MASK
TMPUL	EQU 80H		;TIMER PULSES MASK BIT
TRATE	EQU 250		;VALUE FOR 0.1 SECOND


DIALPL	LDA	PMMIBYTE	;FLAG FOR PMMI OPERATION
	ORA	A		;SET FLAGS
	RZ			;PMMI FALSE, RETURN
7	XRA	A		; 0
7	STA	CRFLAG		;CONTINUOUS REDIAL FLAG
	CALL	DIALPL0		; DISCONNECT, RECONNECT, WAIT DIAL TONE
7	JC	DILAGN		;ASK IF TRY AGAIN
7	LXI	H,CMDBUF+1	;POINT # OF CHARS IN BUFF
7	MOV	A,M		;GET # OF CHARS
7	CPI	4		;4 OR MORE CHARS TYPED BEFORE <CR>?
7	JC	ENTNUM		;NO, ASK FOR NUMBER
7	LXI	H,CMDBUF+5	;POINT TO NUMBER TO DIAL
7	JMP	DIAL10		;CHECK IF LIB #, & DIAL

DIALPL0	CALL DISCONNT
	CALL ILPRT
        DB CR,LF,'WAITING FOR DIAL TONE',CR,LF,0

	MVI A,MAKEM	;MAKE MAKE (OFF-HOOK)
	CALL OUT$MODCTLP;DO IT
	MVI D,DTMSK	;DIAL TONE MASK
	MVI C,100	;10 SECOND WAIT
	CALL WAIT	;WAIT FOR DIAL TONE
7	NOP		;DELAY

; WAIT SUBROUTINE WILL RETURN WITH CARRY SET IF UNABLE TO
; GET DIALTONE, ELSE CARRY NOT SET MEANS DIALTONE RECEIVED

	RNC		;IF DIAL TONE WITHIN 10 SECONDS
	CALL ILPRT	;ELSE, MESSAGE AND RETURN WITH CARRY SET
	DB CR,LF
	DB '++NO DIAL TONE AFTER 10 SECONDS++',CR,LF,0
	STC
	RET

ENTNUM:	;this is all the set-up for the print at entnum2.

7	mvi	c,13		;number of lines to move
7	lxi	h,numblib	;address of source memory
7	lxi	d,dbuf		;address of target memory
7	call	newline		;start with CRLF
7	stax	d		;+LF
7	inx	d		;and bump it

entnum1:
7	mvi	b,30		;number of bytes to move
7	call	move		;move to buffer
7	call	spaces		;2 entries + 3 spaces = 63 characters
7	mvi	b,30
7	call	move
7	call	newline
7	dcr	c		;number of lines to print
7	jz	entnum2
7	jmp	entnum1

newline:			;puts CR-LF at memory pointed by DE
7	mvi	a,cr		;CR
7	stax	d		;store it
7	mvi	a,lf		;LF
7	inx	d		;bump pointer
7	stax	d		;store LF
7	inx	d		;bump pointer
7	ret

spaces:
7	mvi	a,20H		;space
7	stax d ! inx d		; 1
7	stax d ! inx d		; 2
7	stax d ! inx d		; 3
7	ret

entnum2:
	mvi	a,'$'
	stax	d
	mvi	c,print
	lxi	d,dbuf	;point to table of numbers to print
	call	bdos
	call	crlf

	CALL ILPRT
	DB 'ENTER NUMBER OR LIBRARY LETTER - TYPE C/R WHEN FINISHED,',CR,LF
	DB 'CTRL-X CANCELS WHILE DIALING:        ',0

	LXI D,CMDBUF
	CALL INBUFF

DIALLP1	LDA CMDBUF+1
	ORA A			;NULL MEANS <CR> WAS TYPED
	JZ BORTIT		;ABORT DIALING, RETURN TO MENU

	LXI	H,CMDBUF+2	;FIRST TYPED CHAR OF NUMBER TO DIAL
7 ;
7 ; ENTER THIS ROUTINE WITH HL POINTING TO NUMBER TO DIAL
7 ;
DIAL10:
7	MVI	B,'A'		;FIRST LETTER OF ALPHABET
7	MVI	E,0		;COUNTS NUMBER OF LETTERS TO MATCH
7	MVI	C,26		;NUMBER OF LETTERS IN ALPHABET
7	MOV	A,M		;GET CHAR BUFFER
DIAL11:
7	CMP	B		;NUMBER FROM TABLE?
7	JZ	LIBSET
7	INR	B		;MAKE NEXT LETTER (A-Z)
7	INR	E		;COUNT UP
	DCR	C		;COUNT DOWN
7	JZ	DIALLPX		;NOT A LETTER
7	JMP	DIAL11		;LOOP

LIBSET:
7	LXI	H,NUMBLIB	;PHONE NUMBER LIBRARY
7	LXI	B,30		;LENGTH OF LIBRARY ENTRY
7	MOV	A,E		;NUMBER OF TIMES TO ADD 30 TO HL
7	ORA	A		;SET FLAGS
7	JZ	DIAL13

DIAL12:
7	MOV	A,M		;GET FIRST CHAR OF SELECTED LIB ENTRY
7	ORA	A		;SET FLAGS
7	JZ	DIALLP2		;SEND BADLIB MSG
7	DAD	B		;INCREMENT HL BY 30
7	DCR	E		;COUNTDOWN
7	JNZ	DIAL12		;NOT THERE YET, LOOP

DIAL13:
7	MVI	E,30		;NUMBER OF CHARACTERS TO GET FROM TABLE
7	JMP	DIALLP2

DIALLPX	LDA CMDBUF+1
	MOV E,A			;NUMBER OF CHARS IN BUFF
	LXI H,CMDBUF+2		;POINT FIRST CHAR

DIALLP2	MOV A,M			;GET FIRST # FROM BUFFER
7 ;
7 ; ROUTINE TO PRINT 'BADLIB' MESSAGE AND ABORT IF NULL ENCOUNTERED
7 ;
7	ORA	A		;SET FLAGS
7	PUSH	D		;SAVE DE REGISTERS
7	LXI	D,BADLIB	;BAD LIBRARY NUMBER IF NULL
7	MVI	C,PRINT		; 9
7	PUSH	PSW		;SAVE A AND FLAGS
7	CZ	BDOS
7	POP	PSW		;RESTORE A AND FLAGS
7	POP	D		;RESTORE DE REGISTERS
7	JZ	BORTIT		;ABORT
;
; DIAL A DIGIT, CHECK KBD FOR ABORT
;
	CALL DIAL		;DIAL IT
	CALL STAT		; KEYPRESS?
	ORA A			;SET FLAGS
	CNZ KEYIN		;YES, GO GET IT
	CPI CAN			; ^X?
	JZ BORTIT		;YES, ABORT
	INX H			;BUMP POINTER
	PUSH D			;SAVE DE
	PUSH H			;SAVE HL
	MVI B,1			;WAIT 1 TIME INTERVAL
	CALL TIMER
	POP H			;RESTORE HL
	POP D			;RESTORE DE
	DCR E			;COUNT DOWN CHARS IN BUFF
	JNZ DIALLP2		;NOT DONE, LOOP
	JZ DIALDN		;DIALING DONE

DISCONNT
	XRA A			;0
	CALL OUT$MODCTL2	;CLEAR DAV, ESD, ETC
	CALL OUT$MODCTLP	;HANG-UP
	PUSH B
	MVI B,8			;wait for PMMI to disconnect
	CALL TIMER
	POP B
	RET

TIMER	MVI A,TRATE	;TRATE 250, VALUE FOR .1 SEC INTERVAL
	CALL OUT$BAUDRP	;B-REG CONTAINS NUMBER OF .1 SEC INTERVALS
TIMES	CALL IN$BAUDRP	;TO COUNT
	ANI TMPUL
	JZ TIMES	;WAIT FOR TIMER TO GO HIGH
TIMEE	CALL IN$BAUDRP
	ANI TMPUL
	JNZ TIMEE	;WAIT FOR TIMER TO GO LOW
	DCR B
	JNZ TIMES
	RET

BORTIT	CALL DISCONNT
	JMP MENU

;AUTO DIALER

DIAL	CALL	TYPE	;PRINT WHATEVER CHARACTER, DASHES, ETC.
	CPI 30H
	RC		;DIGIT MUST BE AT LEAST 0..
	CPI 3AH
	RNC		;..AND NOT MORE THAN 9
	ANI 0FH		;STRIP ASCII -- COULD ALSO DO SUI 30H ('0')
	CPI 0
	JNZ DIALS
	MVI A,10	;CONVERT ZERO TO 10 PULSES
DIALS	MOV C,A
	LDA PULSERATE	;CONTAINS VALUE FOR DIAL SPEED
	CALL OUT$BAUDRP
DIALC	CALL IN$BAUDRP
	ANI TMPUL
	JNZ DIALC
DIALB	CALL IN$BAUDRP
	ANI TMPUL
	JZ DIALB
MAKEP	MVI A,MAKEM
	CALL OUT$MODCTLP
TIMEM	CALL IN$BAUDRP
	ANI TMPUL
	JNZ TIMEM
	MVI A,BRKM
	CALL OUT$MODCTLP
TIMEB	CALL IN$BAUDRP
	ANI TMPUL
	JZ TIMEB
	DCR C
	JNZ MAKEP
	MVI A,MAKEM
	CALL OUT$MODCTLP
	MVI B,2
	CALL TIMER
	RET

;TIME OUT ROUTINE. MUST BE CALLED WITH MASK IN D REG FOR INPUT
;AT RELATIVE PORT 2 AND NUMBER OF SECONDS * 10 IN C REG.

WAIT	MVI B,1	
	CALL TIMER	;WAIT FOR TIMER TO GO HIGH THEN LOW
	CALL IN$BAUDRP	;PMMIADDR+2 (MODEM STATUS PORT)
	ANA D		;(CTS or DIALTONE MASK)
	RZ		;ACTIVE LOW, SO RETURN ON 0

7	  PUSH B	;SAVE..
7	  PUSH D	;..ACTIVE REG'S
7	  CALL STAT	;KEYPRESS?
7	  ORA A		;SET FLAGS
7	  CNZ KEYIN	;YES, GET CHAR
7	  CPI CAN	;^X?
7	  JZ WAIT1	;YES, DISCONNECT, JMP TO MENU
7	  POP D		;RESTORE..
7	  POP B		;..REGS

	DCR C		;COUNT-DOWN
	JNZ WAIT
	STC		;SET CARRY TO INDICATE MASK NOT SET
	RET

WAIT1:
7	POP D		;RESET..
7	POP B		;..STACK
7	JMP DISCON1	;DISCONNECT

HANGP	MVI A,CLEAR
	CALL OUT$MODCTL2
	MVI A,0
	CALL OUT$MODCTLP
	RET

DIALDN	CALL CRLF
	MVI A,07FH		;TURN ON DTR
	CALL OUT$MODCTL2	;TIMER RATE?

	MVI B,1
	CALL TIMER	;WAIT FOR MODEM TO TURN ON DTR

	MVI A,5DH	;2 STOP BITS, NO PARITY, 8 DATA BITS
			;+ NO DISCONNECT AFTER 17 SECS
	CALL OUT$MODCTLP

	MVI D,4		;CLEAR TO SEND MASK
	MVI C,waitcts	;wait time for cts (25.5 SEC MAX)
	CALL WAIT

	JNC CONMADE	;CONNECTION MADE

	CALL DISCONNT
DILAGN:
7	LDA CRFLAG	;CONTINUOUS REDIAL FLAG
7	ORA A
7	JNZ DILAGN0
	CALL ILPRT
	DB CR,LF,'No answer after time-out.  Redial? (Y/N/C): ',BELL,0

	CALL KEYIN	;GET RESPONSE
	CALL TYPE	;ECHO IT
	CALL UCASE	;ANI 5FH
	CALL CRLF	;NEW LINE
	CPI 'N'		;REDIAL?
	JZ MENU		;NO, GO MENU
	CPI 'Y'		;REDIAL?
	JZ DILAGN0	;YES, REDIAL
7	CPI 'C'		;CONTINUOUS REDIAL?
7	JNZ DILAGN	;INVALID RESPONSE, ASK AGAIN
7	XRA A ! CMA	;0FFH
7	STA CRFLAG	;CONTINUOUS REDIAL FLAG
7 DILAGN0:
7	mvi b,50	;5 seconds wait for pmmi reset
7	call timer	;else busy tone may be sensed as dialtone
	CALL DIALPL0	;WAIT FOR DIAL TONE
	JNC DIALLP1	;DIAL NUMBER
7	JMP DILAGN	;NO DIAL TONE AFTER 10 SECS

CONMADE	CALL ILPRT
        DB CR,LF,'Connection established - Select options: ',BELL,0
DILAGN1
7	CALL STAT	;KEYPRESS?
7	ORA A		;SET FLAGS
7	JNZ GETCMD	;KEY PRESSED, GO GET OPTIONS
7	MVI A,BELL
7	CALL TYPE	;RING BELL
7	JMP DILAGN1	;LOOP


;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,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	LDA PMMIBYTE
	ORA A
	RZ
	CALL ILPRT
	DB 'Enter New Baudrate: ',0
	LXI H,FCB+9
	MVI M,0		;PUTS A ZERO IN FIRST POSITION SO AS TO
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,CR,LF
	DB 'WRT   - Write file to disk (from terminal mode)',CR,LF
	DB 'DEL   - Erase present file (from terminal mode)',CR,LF
	DB 'RET   - Return to terminal mode with no loss of data',CR,LF,0
	LDA PMMIBYTE
	ORA A
	JZ S5
	CALL ILPRT
	DB 'DSC   - Disconnect',CR,LF
	DB 'CAL   - Dial number',CR,LF,0
S5	CALL ILPRT
	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
	DB 'S     - Send CP/M file',CR,LF
	DB 'R     - Receive CP/M file',CR,LF
	DB 'T     - Terminal mode (optional file name)',CR,LF
	DB 'E     - Terminal mode with echo',CR,LF,0
XPRT	CALL ILPRT
	DB CR,LF,CR,LF,'DEFAULT DRIVE: ',0
	MVI C,25	;CURRENT DISK FUNCTION
	CALL BDOS
	ADI 41H		;MAKE ASCII
	CALL TYPE
	CALL ILPRT
	DB CR,LF,CR,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
	LDA PMMIBYTE
	ORA A
	JZ S6
	CALL ILCOMP		;DE SET FROM 1ST ILCOMP CALL
	DB 'DSC',0
	JNC DISCON1
S6	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.

DISCON1	LDA PMMIBYTE
	ORA A
	JZ MENU
	CALL DISCONNT
	CALL ILPRT
	DB CR,LF,'++DISCONNECTED++',CR,LF,BELL,0
	JMP MENU1

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
	OUT FRONTPAN
	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
	OUT FRONTPAN
	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,'$'
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