TITLE	'CP/M MODEM PROGRAM Version 7.6'
;
;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.

;4/12/82  Merged in changes/enhancements from versions 7.32
;and 7.4 and MODEM75.FIX.  This should hopefully give us one
;"master" version again.  B. R. Ratoff
;Summary:
; @7.32 - Delay loop at DILAGN1 to allow "smart" terminals time
;         to process bell character.
;
; @MODEM75.FIX - Maintain originate mode on RET command after
;         transferring files (at TERM:).  Restore option tables correctly
;         on control-D command (at DIR).  Issue "file open" message on
;         receive (at RCVC3).
; @7.41 - Make CRC/checksum switching on Receive automatic....
;         assumes CRC and defaults to checksum on timeout.
;

;2/20/82  Changes at TERM and START1 marked by ; @7.5 fix a
;long standing bug in MODEM7x that causes abort at the end of a
;batch file transfer or an attempt to transfer a non-existent
;file.  The call to NOPARIT in DONETCE caused a computer that was
;in answer mode (but not explicitly by command option) to switch
;to originate mode thus causing the two ends to no longer communicate
;with each other.  Also added SAVCCP byte and code to prevent
;overwriting of the CCP at the users option.       R. L. Plouffe 

;1/23/82  The following changes have been made in this version.
;							RLP
;Extensive cleanup of the file including colons after all labels
;for easier search with screen editor for the purposes of debug.
;Also set file capture mode so as not to overwite the CCP and
;changed EXIT to return to the CCP instead of doing warm boot.
;
;TERML routine fix:
;Added Rick Kawala's fix so that fewer framing errors will occur
;with hosts that send out characters with high bit set.
;
;CAL command fix:
;   All versions of MODEM7 including MODEM73 are supposed to be
;able to accept "CAL n" (where n is either a library letter or
;a phone-number string) as a valid form of the CAL command.  In
;fact, however, the "n" will simply be ignored.  This is because
;routine DIALPL checks for a command length >= 4 as a signal to
;skip the library display, but the menu routine, after
;recognizing CAL, sets the length to 1 so the L in CAL doesn't
;look like an illegal secondary option.
;   The following kludge repairs this defect.  In routine
;DIALPL, two lines above label DIALPL0, change CMDBUF+5 to
;CMDBUF+6.  Also, in routine GETCMD, three lines above label
;NXTOPT2, change MVI A,1 to MVI A,20H and change the next line
;from STA CMDBUF+1 to STA CMDBUF+4.  This makes the command
;look to the option processor like "CA  n", and since A is a
;legal secondary option (which in this case is never used) the
;line passes muster.  If an actual telephone number is used,
;you have to type an extra blank: CAL  000-0000, whereas
;with library numbers one blank only must be typed: CAL A.

;12/16/81 Removed stack imbalance bug at COLONB by adding
;	  a JMP BRK1. Change is marked by ;@   R. L. Plouffe

;11/21/81  Fixed code so byte received is on same line when
;	   messages "XXH RCD, NOT SOH" or "XXH RCD, NOT ACK"
;          are displayed. Also changed stack size to 50H.
;	   (P.L.Kelley)

;10/29/81 Changed receive sector routine so that on the first
;time through when CRC is being used, it only waits 3 seconds
;to receive the SOH after sending the initial 'C'.  If a
;character is not received within 3 seconds, then a NAK is
;sent and this program switches to CHECKSUM mode.  The sending
;of the NAK causes XMODEM or MODEM to start sending the file
;using checksum checking.  This allows the CRC MODEM7 program
;to be used with versions of XMODEM, MODEM, and MODEM7 that
;do not use CRC, even when MODEM7 has specified a CRC
;transmission. (John Mahr)

;10/18/81 Added CRC option. This is another secondary option
;that is specified by giving a 'C'.
;	MODEM RC.600 fn.ft
;	MODEM ROC.300 fn.ft etc.
;	note: cannot have more than 6 secondary options.
;When the file receive cmd. specifies CRC, the ltr. 'C' is
;sent in place of the initial NAK. This signals the sender
;(XMODEM54 or equiv.) that CRC is in effect. The sending 
;program will repalce the checksum with the CRC 2 bytes.
;CRC will give better than a 99.99% probability that there
;are no data errors. Code copied from MODEM213, thanks to
;John Mahr and Paul Hansknecht for the implementation. (WDE)

;10/11/81 Add first NAK to RCVFIL to speed up start
;Removed monitor scroll from good block messages
;CTL-^ forces send of next char in T mode (for ctl-E,ctl-D) (WDE)

;07/05/81 Added BRR ctrl char chgs, my number list (Bill Earnest)

;06/05/81 Deleted some unneeded messages in the dial routines. (Bob Clyne)

;05/31/81 Added detection of framing, overrun, and parity errors for
;	  Receive file routine. (A modified version of the routines in
;	  MODEM V2.06)

;	  Added provisions to send and receive either even or odd parity
;	  bit with PMMI modem in the 'S'end or 'R'eceive file modes - resets
;	  to no parity in other modes. Use of the parity feature will slow
;	  transfers slightly due to the extra (parity) bit being sent with
;	  each character. Also this is the only program that I KNOW OF that
;	  actually sends, or sets up the PMMI to receive, the parity bit.
;	  Both ends must be set to the same parity for it to work. Parity
;	  is invoked by adding a '0' (ASCII) for even parity or a '1' (ASCII)
;	  for odd parity to the 'S'end or 'R'eceive command string eg. R0.600.

;	  Changed timing for sending 'B'reak in the terminal mode.

;	  Changed the code so that the 'M'enu command works from the keyboard
;	  even when in XPR (expert) mode.

;	  Added display of hex in addition to decimal numbers for file length
;	  and sector numbers.

;	  Removed provision for remote cancel of file transfers in the 'S'end
;	  and 'R'eceive modes to prevent line noise from aborting a transfer.
;	  (Bob Clyne)


;02/15/81 Patched in the ringback routines from DIAL6/23. It doesn't
;	  seem to be able to recognize when the other phone is ringing
;	  though so it is a little shakey.

;	  Put in routines to calculate file sizes and sector numbers in
;	  decimal.

;	  Put in code to transmit a "BREAK" with a PMMI for use with
;	  computers which use BREAK instead of Control S to suspend
;	  output. Control P is now the baudrate change request key
;	  and Control @ is the BREAK key.. (Bob Clyne)


;12/18/80 Changed disconnect timing.

;10/26/80  Minor revision 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.

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


TRUE	EQU 0FFH
FALSE	EQU 0

CPM2X		EQU TRUE ;true if CP/M 2.X
DBUFSIZ		EQU 16	 ;BUFFER SIZE IN KBYTES

; PMMI EQUATES

PORT	EQU	0C0H	;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
BRKMSK	EQU	0FBH	;MASK TO SET BREAK
FRMER	EQU	20H	;FRAMING ERROR MASK
ORUNER	EQU	10H	;OVERRUN ERROR MASK
PARER	EQU	08H	;PARITY ERROR MASK
ODPARMSK EQU	0CFH	;MASK TO SET ODD PARITY
EVPARMSK EQU	20H	;MASK TO SET EVEN PARITY
NOPARMSK EQU	10H	;MASK TO RESET TO NO PARITY
ERRCDMSK EQU	38H	;MASK FOR ALL BITS EXCEPT ERROR CODES

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

CHGBAUD	EQU 'P'-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
BRKCHR	EQU '@'-40H	; ^@ = TRANSMIT "BREAK" WITH PMMI
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
EXTCHR	EQU '^'-40H	; ^^ = SEND NXT CHR
SOH	EQU 1		; START OF HEADER
EOT	EQU 4		; END OF TEXT
ACK	EQU 6		; ACKNOWLEDGE
NAK	EQU 15H		; NOT ACKNOWLEDGE
CRC	EQU 'C'		;USED TO RQST CRC INSTEAD OF CLSUM
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  FALSE	;true=make .BAK file
XPRFLG:		DB  TRUE	;true=no menu, false=print menu
PULSERATE:	DB  125		;125 FOR 20PPS, 250 FOR 10PPS dialing
SAVCCP		DB  TRUE	;true=do not overwrite CCP
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
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
OUT$MODCTLP:	OUT MODCTLP ! STA UARTCTLB ! RET ;out modem control port
						 ;and store control byte

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.

NUMBLIB:
;	'----5---10---15---20---25---30'
DB	'A=Amrad           703-734-1387'	;'A'
DB	'B=Ben Bronson     312-955-4493'	;'B'
DB	'C=                            '	;'C'
DB	'D=C.Cliff C.C.    312-234-9257'	;'D'
DB	'E=Ron Fowler     313-729-1905R'	;'E'
DB	'F=                            '	;'F'
DB	'G=Gasnet NASA     301-344-9156'	;'G'
DB	'H=Dave Hardy      313-846-6127'	;'H'
DB	'I=Wayne Hammerly  301-953-3753'	;'I'
DB	'J=                            '	;'J'
DB	'K=David Kozinn    216-334-4604'	;'K'
DB	'L=Program Store   202-337-4694'	;'L'
DB	'M=Kelly Smith     805-527-9321'	;'M'
DB	'N=                            '	;'N'
DB	'O=SYSOP Sys       313-885-0506'	;'O'
DB	'P=K.Petersen     313-759-6569R'	;'P'
DB	'Q=R.Plouffe       703-524-2549'	;'Q'
DB	'R=Bruce Ratoff    201-272-1874'	;'R'
DB	'S=                            '	;'S'
DB	'T=Tech. CBBS      313-846-6127'	;'T'
DB	'U=PMMI            703-379-0303'	;'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,'MODEM 7.6 as of 4/12/82',cr,lf
	DB 'Originally Written by Ward Christensen',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	ORIGFLG	; @7.5
	ORA	A	; @7.5 
	MVI	A,ANSWMOD ; @7.5
	STA	UARTCTLB  ; @7.5
	JNZ	START2	; @7.5
	MVI	A,ORIGMOD ; @7.5
	STA	UARTCTLB  ; @7.5
START2:	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	MENU2	;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	;
	OUT	FRONTPAN ;0FFH PORT FOR IMSAI FRONT PANEL
	CMA		; 0
	STA	SAVEFLG	;
	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:
	LDA	ORIGFLG	; @7.5
	sta	origsav	; @MODEM75.FIX
	ORA	A	; @7.5 
	MVI	A,ANSWMOD ; @7.5
	STA	UARTCTLB  ; @7.5
	JNZ	TERM2	; @7.5
	MVI	A,ORIGMOD ; @7.5
	STA	UARTCTLB  ; @7.5
TERM2:	CALL	STAT	;KEYPRESS?
	JZ	TERML	;NO, CHECK LINE
	CALL	KEYIN	;GET CHAR FROM KBD
	MOV	B,A	;SAVE
	LDA	EXACFL
	ORA	A	;EXACT?
	MVI	A,0
	STA	EXACFL	;CLR FOR NEXT TIME
	MOV	A,B	;RESTORE
	JNZ	NOTOG
	CPI	EXITCHR	;^E?
	JZ	MENU	;YES, RETURN TO MENU
	CPI	DISCCHR	;^D?
	JZ	DISCON1	;YES, DISCONNECT & RETURN TO MENU
	CPI	EXTCHR	;^^?
	JZ	EXTFLG	;YES, SET FLAG FOR NXT CHAR

	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	BRKCHR	;BREAK?
	JZ	BREAK
	CPI	CHGBAUD
	PUSH	PSW
	PUSH	H
	CZ	NEWBAUD
	POP	H
	POP	PSW
	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

EXTFLG:	MVI	A,TRUE
	STA	EXACFL
	JMP	TERML

NOTOG:	CALL	OUT$MODDATP

TERML:	CALL	IN$MODCTLP
	CALL	ANI$MODRCVB
	CALL	CPI$MODRCVR
	JNZ	TERM
	CALL	IN$MODDATP
	ANI	7FH	;STRIP PARITY
	JZ	TERM		
	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..
	PUSH	PSW
	LDA	SAVCCP
	ORA	A
	JZ	SUB1
	POP	PSW
	SBI	8	;..PAGE BELOW CCP ..
SUB1:	DCR	A	;..OR 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

BREAK:	PUSH	D	;SAVE IT
	LXI	D,0	;ZERO IT
	LDA	MODCTLB	;GET THE LAST MODEM CONTROL BYTE
	ANI	0FBH	;SET THE TRANSMIT BREAK BIT LOW - ACTIVE LOW
	CALL	OUT$MODCTL2 ;SEND IT TO THE MODEM
	LDA	FASTCLK	;GET FAST CLOCK FLAG
	ORA	A	;SET FLAGS
	LXI	B,450	;BREAK DELAY COUNTER FOR SLOW CLOCK
	JZ	BRK1	;JUMP IF NOT FAST CLOCK
	LXI	B,900	;BREAK DELAY COUNTER FOR FAST CLOCK
BRK1:	CALL	TIMERL
	JZ	BRK2	;IF TIME IS UP RESET BREAK
	CPI	0	;CHECK FOR NULLS
	JZ	BRK1	;DON'T PROCESS THEM
	ANI	7FH	;STRIP PARITY
	CALL	TYPE
	PUSH	PSW
	LDA	SAVEFLG
	CPI	FALSE
	JZ	NOSAVEB
	POP	PSW
	MOV	M,A
	INX	H
	SHLD	HLSAVE	;MENU COMMAND DESTROYS HL-REG..
		;..GET	HL WHEN ENTERING VIA 'RET' CMD.
	PUSH	D
	MOV	D,A
	LDA	IMSAIBYTE
	ORA	A
	MOV	A,D
	POP	D
	JZ	COLONB
	CMA	;FRONT	PANEL SHOWS CHARS WHEN..
	OUT	FRONTPAN ;..MEMORY SAVE IS ACTIVE.
	JMP	BRK1
COLONB:	CPI	LF	;IF NO FRONT PANEL, THEN..
	JNZ	BRK1	;..TYPE ":" AFTER EACH LINE FEED..
	MVI	A,':'	;..WHEN MEMORY SAVE ACTIVE.
	CALL	TYPE
	JMP	BRK1	;@
NOSAVEB: POP	PSW	;RESTORE IT
	JMP	BRK1

BRK2:	LDA	MODCTLB	;GET MODEM CONTROL BYTE
	CALL	OUT$MODCTL2
	POP	D
	LHLD	HLSAVE	;LAST ADDRESS WRITTEN IF DATA BEING SAVED
	LDA	7	;CHECK TO SEE IF..
	PUSH	PSW
	LDA	SAVCCP
	ORA	A
	JZ	SUB2
	POP	PSW
	SBI	8	;..PAGE BELOW CCP ..
SUB2:	DCR	A	;..OR BDOS HAS BEEN ..
	CMP	H	;..REACHED AND DISKSAVE IS NEEDED.
	JNZ	TERM	;NO PROBLEM - GO BACK TO NORMAL ROUTINE
	CALL	ILPRT
DB	CR,LF,'Memory save buffer full',CR,LF,BELL,0
	JMP	TERM


;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
	LXI	B,1250
	JZ	TIMERL
	LXI	B,2500
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


;		SEND A CP/M FILE

SENDFIL:
	CALL	PARITY	;SET PARITY IF REQUESTED
	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	CNREC	;GET NUMBER OF RECORDS
	CALL	OPENFIL
	MVI	E,80
	CALL	WAITNAK
SENDLP:	CALL	RDSECT
	JC	SENDEOF
	CALL	INCRSNO
	XRA	A
	STA	ERRCT
SENDRPT:
	CALL	SENDHDR
	CALL	SENDSEC
	LDA	CRCFLG
	ORA	A
	CZ	SENDCRC
	CNZ	SENDCKS
	CALL	GETACK
	JC	SENDRPT
	JMP	SENDLP

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

;		RECEIVE A FILE

RCVFIL:	xra	a	;@7.41 - default to CRC mode
	sta	CRCFLG	;@7.41
	CALL	PARITY	;SET PARITY IF REQUESTED
	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	batchflg;@75.FIX.................
	ora	a	;DON'T PRINT MSSG IF..
	jnz	rcvc4	;..IN MULTI AND QUIET.
	lda	qflg
	ora	a
	jz	rcvfst
rcvc4:	CALL	ILPRT	;@75.FIX.................
DB	'File open, ready to receive',CR,LF,0
RCVFST:	LDA	CRCFLG
	ORA	A
	MVI	A,NAK
	JNZ	RCVFIL2
	MVI	A,CRC
;
RCVFIL2:
	CALL	SEND
	lda	CRCFLG		;@7.41...............................
	ora	a
	jnz	RCVNAKM		;if in CRC mode
	call	ILPRT		;then say so
	DB	'CRC in effect',cr,lf,0
	jmp	RCVLP
RCVNAKM:
	call	ILPRT		;else say checksum mode
	DB	'Checksum in effect',cr,lf,0
				;@7.41...............................
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	ACK	;IF ACK,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:	XRA	A	;ZERO ACCUM
	STA	ERRCDE	;CLEAR RECEIVE ERROR CODE
	LDA	QFLG
	ORA	A
	JZ	RCVSQ
	CALL	ILPRT
DB	CR,'Awaiting # ',0
	PUSH	H	;SAVE IT
	LHLD	SECTNO	;GET SECTOR NUMBER
	INX	H	;BUMP IT
	CALL	DECOUT	;PRINT SECTOR NUMBER IN DECIMAL
	CALL	ILPRT
	DB	' (', 0
	CALL	DHXOUT	;16 BIT HEX CONVERSION & OUTPUT
	CALL	ILPRT
	DB	'H)',0
	MOV	A,L	;ONLY LOW BYTE USED BY PROGRAM
	POP	H	;RESTORE IT
;
;---->	RCVSQ:
;	If CRC is in effect, there is only a 3 second wait
;	for the first SOH.  If the SOH is not received within
;	3 seconds, then a NAK is sent which tells the sender
;	to use checksum checking instead of CRC.  This allows
;	automatic compatability with versions of XMODEM that
;	do not implement Cyclic Redundancy Checking(CRC).
;
RCVSQ:	LDA	FIRSTME	;first SOH...
	ORA	A	;...been received?
	JZ	RCVSQ2	;yes, go get next SOH
	XRA	A	;turn off...
	STA	FIRSTME	;...first soh recvd switch
	LDA	CRCFLG	;CRC in...
	ORA	A	;...effect?
	JNZ	RCVSQ2	;no, do long wait for first SOH
	MVI	B,3	;wait for upto 3 seconds
	CALL	RECV	;get a character from modem
	JNC	RCVSQ3	;got a char, go see if SOH
	CALL	ILPRT
DB	CR,LF,'++Switching to CHECKSUM MODE++',CR,LF,0
	MVI	A,'C'	;turn off...
	STA	CRCFLG	;...CRC mode.
	MVI	A,NAK	;send NAK to tell sender checksum
	CALL	SEND	;...is in effect & to start sending.
	JMP	RCVSECT	;go start receiving sector
;
RCVSQ2:	MVI	B,7	;10 IN ORIG PROG
	CALL	RECV
	JC	RCVSTOT
;
RCVSQ3:	CALL	RCVERR	;CHECK FOR ERRORS
	JC	RCVDERR	;JUMP IF THERE WAS AN ERROR
	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	CRLF
	CALL	HEXO
	CALL	ILPRT
DB	'H recv''d, 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	CR,LF,'++Unable to receive block - Aborting++',CR,LF,'$'

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

;---->	RCVERR:
;	Checks for framing, overrun, and parity errors. Parity errors
;	cannot be detected unless the parity option has been selected.
;	1.Error code (ERRCDE) was set in RECV routine.
;	2.ERRCDE=0 for no errors, ERRCDE<>0 for errors.
;	3.If there is an error, routine returns with carry flag set.

RCVERR:	PUSH	PSW	;SAVE CHAR TRANSMITTED
	LDA	ERRCDE	;GET RECEIVE ERROR CODE
	ANA	A	;IS IT ZERO?
	JZ	RCVERR2	;YES, NO RECEIVE ERROR
	POP	PSW	;RESTORE CHAR TRANSMITTED
	STC		;SET CARRY ON TO INDICATE AN ERROR
	RET

RCVERR2:
	POP	PSW	;RESTORE CHAR TRANSMITTED
	RET

;---->	RCVDERR: Checks for a receive error and displays appropriate error
;	message. Then goes to RCVSERR to purge the line and send a NAK.

RCVDERR:
	LDA	VSEEFLG	;VIEWING
	ORA	A	;...MODE?
	JZ	RCVDERRP ;YES,..PRT MSG
	LDA	QFLG	;QUIET...
	ORA	A	;...MODE?
	JZ	RCVSERR	;YES, NO MSG

RCVDERRP: CALL ILPRT
	DB	CR,LF,0
	LDA	ERRCDE	;GET RECEIVE ERR CODE
	ANI	FRMER	;WAS THERE A FRAMING ERROR?
	JZ	RCVDERR2 ;NO, GO CHECK FOR OVERRUN
	CALL	ILPRT
DB	'++Framing error++ ',0
	CALL	RCVDERR5 ;PRINT # OF ERROR

RCVDERR2:
	LDA	ERRCDE	;GET RECEIVE ERR CODE
	ANI	ORUNER	;WAS THERE AN OVERRUN
	JZ	RCVDERR3 ;NO, GO CHECK FOR PARITY ERROR
	CALL	ILPRT
DB	'++Overrun error++ ',0
	CALL	RCVDERR5

RCVDERR3:
	LDA	ERRCDE	;GET RECEIVE ERR CODE
	ANI	PARER	;WAS THERE A PARITY ERROR?
	JZ	RCVDERR4 ;NO, GO PURGE LINE
	CALL	ILPRT
DB	'++Parity error++ ',0
	CALL	RCVDERR5

RCVDERR4: JMP	RCVSERR	;GO PURGE LINE, SEND NAK

;Display the number of the error, do a carriage return and line feed.
RCVDERR5:
	LDA	ERRCT	;GET ERROR NUMBER
	CALL	HEXO	;DISPLAY IT
	CALL	CRLF	;DO CR, LF
	RET

RCVSOH:	MVI	B,1
	CALL	RECV
	JC	RCVSTOT
	CALL	RCVERR	;CHECK FOR RECEIVE ERROR
	JC	RCVDERR
	MOV	D,A
	MVI	B,1
	CALL	RECV
	JC	RCVSTOT
	CALL	RCVERR	;CHECK FOR RECEIVE ERROR
	JC	RCVDERR
	CMA
	CMP	D
	JZ	RCVDATA
	LDA	VSEEFLG
	ORA	A
	JZ	RCVBSE
	LDA	QFLG
	ORA	A
	JZ	RCVSERR
RCVBSE:	CALL	ILPRT
DB	CR,LF,'++  Bad sector # in Hdr',CR,LF,0
	JMP	RCVSERR

RCVDATA:
	MOV	A,D
	STA	RCVSNO
	MVI	A,1
	STA	DATAFLG
	MVI	C,0
	CALL	CLRCRC	;clear crc counter
	LXI H,80H
RCVCHR:	MVI	B,1
	CALL	RECV
	JC	RCVSTOT
	CALL	RCVERR	;CHECK FOR RECEIVE ERROR
	JC	RCVDERR
	MOV	M,A
	INR	L
	JNZ	RCVCHR
	LDA	CRCFLG
	ORA	A
	JZ	RCVCRC
	MOV	D,C
	XRA	A
	STA	DATAFLG
	MVI	B,1
	CALL	RECV
	JC	RCVSTOT
	CALL	RCVERR	;CHECK FOR RECEIVE ERROR
	JC	RCVDERR
	CMP	D
	JNZ	RCVCERR
CHKSNUM:
	LDA	RCVSNO
	MOV	B,A
	LDA	SECTNO
	CMP	B
	JZ	RECVACK
	INR	A
	CMP	B
	JNZ	ABORT
	RET
;
RCVCRC:	MVI	E,2	;nr of crc bytes
	;
RCVCRC2:
	MVI	B,1
	CALL	RECV
	JC	RCVSTOT
	CALL	RCVERR
	JC	RCVDERR
	DCR	E
	JNZ	RCVCRC2
	CALL	CHKCRC
	ORA	A
	JZ	CHKSNUM
	LDA	VSEEFLG
	ORA	A
	JZ	RCVCRER
	LDA	QFLG
	ORA	A
	JZ	RCVSERR
	;
RCVCRER:
	CALL	ILPRT
DB	CR,LF,'++CRC error++',0
	JMP	RCVPRN

RCVCERR:
	LDA	VSEEFLG
	ORA	A
	JZ	RCVCPR
	LDA	QFLG
	ORA	A
	JZ	RCVSERR
RCVCPR:	CALL	ILPRT
DB	'++Cksum error++ ',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	CR,'Send # ',0
	PUSH	H
	LHLD	SECTNO	;GET SECTOR NUMBER
	CALL	DECOUT	;PRINT IT IN DECIMAL
	CALL	ILPRT
	DB	'  (',0
	CALL	DHXOUT	;16 BIT HEX CONVERSION & OUTPUT
	CALL	ILPRT
	DB	'H)',0
	POP	H
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
	CALL	CLRCRC
	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

SENDCRC:
	CALL	FINCRC
	MOV	A,D
	CALL	SEND
	MOV	A,E
	CALL	SEND
	XRA	A
	RET

GETACK:	MVI	B,7	;10 IN ORIG PROG
	CALL	RECVDG
	JC	GETATOT
	CPI	ACK
	RZ
	MOV	B,A
	LDA	QFLG
	ORA	A
	JZ	ACKERR
	MOV	A,B
	CALL	CRLF
	CALL	HEXO
	CALL	ILPRT
DB	'H Recv''d, 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	CR,LF,'Can''t send sector -- Aborting',CR,LF,'$'
	;
GETATOT:
	LDA	QFLG
	ORA	A
	JZ	ACKERR
	CALL	ILPRT
DB	CR,LF,'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	CR,LF,'Routine cancelled',CR,LF,BELL,0
	MVI	A,'B'	;TURN MULTI-FILE MODE..
	STA	BATCHFLG ;..OFF SO ROUTINE ENDS.
	JMP	DONETCE

INCRSNO:
	PUSH	H
	LHLD	SECTNO	;GET SECTOR NUMBER
	INX	H	;BUMP IT
	SHLD	SECTNO	;STORE IT
	MOV	A,L
	POP	H
	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	'File 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,'$'

	IF	CPM2X
CNREC:	MVI	C,FILSIZ ;COMPUTE FILE SIZE FUNCTION IN CP/M 2.x
	LXI	D,FCB	;POINT TO FILE CONTROL BLOCK
	CALL	BDOS
	LHLD	FCB+33	;GET RECORD COUNT
	SHLD	RCNT	;STORE IT
	LXI	H,0	;ZERO HL
	SHLD	FCB+33	;RESET RANDOM RECORD IN FCB
	RET
	ENDIF

	IF	NOT CPM2X
CNREC:	MVI	A,'?'	;MATCH ALL EXTENTS
	STA	FCBEXT
	MVI	A,0FFH
	STA	MAXEXT	;INIT MAX EXT NO.
	MVI	C,SRCHF	;GET 'SEARCH FIRST' FNC
	LXI	D,FCB
	CALL	BDOS	;READ FIRST
	INR	A	;WERE THERE ANY?
	JNZ	SOME	;GOT SOME
	CALL	ERXIT
DB	'++File not found++$'

;READ MORE DIRECTORY ENTRIES
MOREDIR:
	MVI	C,SRCHN	;SEARCH NEXT
	LXI	D,FCB
	CALL	BDOS	;READ DIR ENTRY
	INR	A	;CHECK FOR END (0FFH)
	JNZ	SOME	;NOT END OF DIR...PROCESS EXTENT
	LDA	MAXEXT	;HIT END...GET HIGHEST EXTENT NO. SEEN
	MOV	L,A	;WHICH GIVES EXTENT COUNT -1
	MVI	H,0
	MOV	D,H
	LDA	RCNT	;GET RECORD COUNT OF MAX EXTENT SEEN
	MOV	E,A	;SAVE IT IN DE
	DAD	H
	DAD	H	;MULTIPLY # OF EXTENTS -1
	DAD	H	; TIMES 128
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	DAD	D	;ADD IN SIZE OF LAST EXTENT
	SHLD	RCNT	;SAVE TOTAL RECORD COUNT
	RET	;AND EXIT

;POINT TO DIRECTORY ENTRY
SOME:	DCR	A	;UNDO PREV 'INR A'
	ANI	3	;MAKE MODULUS 4
	ADD	A	;MULTIPLY...
	ADD	A	;..BY 32 BECAUSE
	ADD	A	;..EACH DIRECTORY
	ADD	A	;..ENTRY IS 32
	ADD	A	;..BYTES LONG
	LXI	H,80H ;POINT TO BUFFER
	ADD	L	;POINT TO ENTRY
	ADI	15	;OFFSET TO RECORD COUNT
	MOV	L,A	;HL NOW POINTS TO REC COUNT
	MOV	B,M	;GET RECORD COUNT
	DCX	H
	DCX	H	;BACK DOWN TO EXTENT NUMBER
	DCX	H
	LDA	MAXEXT	;COMPARE WITH CURRENT MAX.
	ORA	A	;IF NO MAX YET
	JM	BIGGER	;THEN SAVE RECORD COUNT ANYWAY
	CMP	M
	JNC	MOREDIR
BIGGER:	MOV	A,B	;SAVE NEW RECORD COUNT
	STA	RCNT
	MOV	A,M	;SAVE NEW MAX. EXTENT NO.
	STA	MAXEXT
	JMP	MOREDIR	;GO FIND MORE EXTENTS
	ENDIF

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, size: ',0
	LHLD	RCNT	;GET RECORD COUNT
	CALL	DECOUT	;PRINT NUMBER OF SECTORS IN DECIMAL
	CALL	ILPRT	;PRINT
	DB	' (',0
	CALL	DHXOUT
	CALL	ILPRT
	DB	'H) sectors',CR,LF,0
	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	DBUFSIZ*8 ;BUFFER SIZE IN 128 BYTE SECTORS
	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	DBUFSIZ*8 ;BUFFER SIZE IN 128 BYTE SECTORS
	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,'$'

;---->	RECV: Receive a character

;Timeout time is in B, in seconds. Entry via 'RECVDG' deletes garbage
;characters on the line. For example, having just sent a sector, calling
;RECVDG will delete any line noise induced characters LONG before the
;ACK/NAK would be received.

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:	LDA	PMMIBYTE ;IS THE MODEM A PMMI?
	ORA	A	;SET FLAGS
	JZ	MCHAR1	;YES, JUMP
	CALL	IN$MODCTLP ;GET ERROR-STATUS BYTE
	ANI	ERRCDMSK ;MASK OUT ALL EXCEPT ERROR BITS (3-5)
	STA	ERRCDE	;SAVE THE ERROR CODE
MCHAR1:	CALL	IN$MODDATP
	POP	D
	PUSH	PSW
	CALL	UPDCRC	;calc crc
	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
	CALl	UPDCRC	;calc crc
	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	CRC	;crc request?
	JZ	WAITCRC	;yes, go set crc flag
	DCR	E
	JZ	ABORT
	JMP	WAITNLP
;
WAITCRC:
	CALL	ILPRT
DB	'CRC request received',CR,LF,0
	XRA	A
	STA	CRCFLG
	RET
;
;--->PARITY: Routine to setup PMMI for odd/even parity.

PARITY:	LDA	PMMIBYTE ;IS MODEM A PMMI?
	ORA	A	;SET FLAGS
	RZ		;NO, RETURN
	LDA	OPARITY	;GET ODD PARITY REQUEST BYTE
	ORA	A	;SET FLAGS
	JNZ	EVENPAR	;IF NOT ODD SEE IF IT IS EVEN
	LDA	UARTCTLB ;GET UART/MODEM CONTROL BYTE
	ANI	ODPARMSK
	JMP	PARITY1

EVENPAR:
	LDA	EPARITY	;GET EVEN PARITY REQUEST BYTE
	ORA	A	;SET FLAGS
	RNZ		;IF EVEN PARITY NOT SPECIFIED RETURN
	LDA	UARTCTLB ;GET UART/MODEM CONTROL BYTE
	ANI	ODPARMSK ;SET FOR PARITY
	ORI	EVPARMSK ;NOW SET FOR EVEN PARITY

PARITY1:
	JMP	OUT$MODCTLP ;SEND TO PMMI -
			;WHEN OUT$MODCTLP DOES RET IT
			;WILL GO BACK TO CALLING ROUTINE

NOPARIT:
	LDA	PMMIBYTE
	ORA	A
	RZ
	LDA	UARTCTLB	;GET UART/MODEM CONTROL BYTE
	ORI	NOPARMSK	;RESET PARITY BIT ON PMMI
	JMP	OUT$MODCTLP


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	CRCFLG
	ORA	A
	JNZ	ENDOPT2
	LDA	OPTION
	CPI	'R'
	JNZ	BADOPT	;crc only allowed for recv
;
ENDOPT2:
	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:
	CALL	NOPARIT	;RESET TO NO PARITY
	mvi	a,crc	;@7.41....................
	sta	CRCFLG	;turn off CRC option
	mvi	a,0FFH
	sta	FIRSTME	;set first-time flag
			;@7.41....................
	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..
	RNZ		;..FORCES 300 BAUD.
	CALL	GETBAUD
FIXBAUD:
	CALL	OUT$BAUDRP
	CPI	52
	MVI	A,5FH
	JC	GT300
	MVI	A,7FH
GT300:	CALL	OUT$MODCTL2
	STA	MODCTLB	;SAVE MODEM CONTROL BYTE
	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

DECOUT:	PUSH	PSW
	PUSH	B
	PUSH	D
	PUSH	H
	LXI	B,-10
	LXI	D,-1

DECOU2:	DAD	B
	INX	D
	JC	DECOU2
	LXI	B,10
	DAD	B
	XCHG
	MOV	A,H
	ORA	L
	CNZ	DECOUT
	MOV	A,E
	ADI	'0'
	CALL	CTYPE
	POP	H
	POP	D
	POP	B
	POP	PSW
	RET

;---->	DHXOUT: - double precision hex output routine.

DHXOUT:	PUSH	H
	PUSH	PSW
	MOV	A,H	;GET MS BYTE
	CALL	HEXO	;OUTPUT HIGH ORDER BYTE
	MOV	A,L	;GET LS BYTE
	CALL	HEXO	;OUTPUT LOW ORDER BYTE
	POP	PSW
	POP	H
	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
	LHLD	STACK
	SPHL
	LDA	SAVCCP
	ORA	A
	JZ	0	;WARM BOOT
	RET

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
RBLMT	EQU 70	;# OF SEC*10 TO WAIT BEFORE GIVING NO RING HEARG MSG
RBWAIT	EQU 50	;# OF SEC*10 DELAY BEFORE REDIALING NUMBER
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
	XRA	A	; 0
	STA	CRFLAG	;CONTINUOUS REDIAL FLAG
	CALL	DIALPL0	; DISCONNECT, RECONNECT, WAIT DIAL TONE
	JC	DILAGN	;ASK IF TRY AGAIN
	LXI	H,CMDBUF+1 ;POINT # OF CHARS IN BUFF
	MOV	A,M	;GET # OF CHARS
	CPI	4	;4 OR MORE CHARS TYPED BEFORE <CR>?
	JC	ENTNUM	;NO, ASK FOR NUMBER
	LXI	H,CMDBUF+6 ;POINT TO NUMBER TO DIAL
	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
	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.
	MVI	C,13	;number of lines to move
	LXI	H,NUMBLIB ;address of source memory
	LXI	D,DBUF	;address of target memory
	CALL	NEWLINE	;start with CRLF
	STAX	D	;+LF
	INX	D	;and bump it

ENTNUM1:
	MVI	B,30	;number of bytes to move
	CALL	MOVE	;move to buffer
	CALL	SPACES	;2 entries + 3 spaces = 63 characters
	MVI	B,30
	CALL	MOVE
	CALL	NEWLINE
	DCR	C	;number of lines to print
	JZ	ENTNUM2
	JMP	ENTNUM1

NEWLINE:		;puts CR-LF at memory pointed by DE
	MVI	A,CR	;CR
	STAX	D	;store it
	MVI	A,LF	;LF
	INX	D	;bump pointer
	STAX	D	;store LF
	INX	D	;bump pointer
	RET

SPACES:
	MVI	A,20H	;space
	STAX D ! INX D	; 1
	STAX D ! INX D	; 2
	STAX D ! INX D	; 3
	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
 ;
 ; ENTER THIS ROUTINE WITH HL POINTING TO NUMBER TO DIAL
 ;
DIAL10:
	MVI	B,'A'	;FIRST LETTER OF ALPHABET
	MVI	E,0	;COUNTS NUMBER OF LETTERS TO MATCH
	MVI	C,26	;NUMBER OF LETTERS IN ALPHABET
	MOV	A,M	;GET CHAR BUFFER
DIAL11:
	CMP	B	;NUMBER FROM TABLE?
	JZ	LIBSET
	INR	B	;MAKE NEXT LETTER (A-Z)
	INR	E	;COUNT UP
	DCR	C	;COUNT DOWN
	JZ	DIALLPX	;NOT A LETTER
	JMP	DIAL11	;LOOP

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

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

DIAL13:
	MVI	B,30	;NUMBER OF CHARACTERS TO GET FROM TABLE
	LXI	D,CMDBUF+1 ;POINT TO BUFFER
	XCHG		;HL POINTS TO CMDBUF+1
	MOV	M,B	;STORE # OF BYTES IN A TABLE ENTRY
	XCHG		;RESTORE REG.
	INX	D	;POINT TO FIRST CHAR POSITION IN BUFFER
	CALL	MOVE	;MOVE TABLE ENTRY TO BUFFER

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
 ;
 ; ROUTINE TO PRINT 'BADLIB' MESSAGE AND ABORT IF NULL ENCOUNTERED
 ;
	ORA	A	;SET FLAGS
	PUSH	D	;SAVE DE REGISTERS
	LXI	D,BADLIB ;BAD LIBRARY NUMBER IF NULL
	MVI	C,PRINT	; 9
	PUSH	PSW	;SAVE A AND FLAGS
	CZ	BDOS
	POP	PSW	;RESTORE A AND FLAGS
	POP	D	;RESTORE DE REGISTERS
	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	'R'	;COULD IT BE A RINGBACK CHARACTER
	JNZ	DIAL1	;NO? - JUMP
	PUSH	PSW	;SAVE ACCUMULATOR & FLAGS
	MOV	A,E	;GET # OF CHAR LEFT INTO ACC.
	CPI	01H	;IS THIS THE LAST CHARACTER?
	JZ	RINGBK	;IF SO, IT MUST BE RINGBACK CHAR - DO RINGBACK
	POP	PSW	;EVERYTHING BACK AS IT WAS
DIAL1:	CPI	3AH
	RNC		;..AND NOT MORE THAN 9
	ANI	0FH	;STRIP ASCII -- COULD ALSO DO SUI 30H ('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

RINGBK:	POP	PSW	;TO GET IT OFF THE STACK
	LDA	CMDBUF+1 ;GET # OF CHAR IN BUFFER
	SUI	01	;SUBTRACT 1 TO AVOID THE RINGBACK CHAR
	STA	CMDBUF+1 ;STORE THE NEW VALUE
	MVI	D,DTMSK	;LOAD TONE DETECT MASK
	MVI	C,RBLMT	;SET TIMER FOR RBLMT NUMBER OF SECONDS
	CALL	WAIT
	JC	RBTIME	;JUMP IF NO RING DETECTED
	MVI	B,25	;WAIT 2.5 SEC
	CALL	TIMER
	CALL	IN$BAUDRP ;IS TONE STILL PRESENT?
	ANA	D
	JNZ	RNGBK1
	JMP	DILAGN	;YES, MUST BE BUSY

RNGBK1:	CALL	HANGP	;HANG UP THE PHONE
	MVI	B,RBWAIT ;WAIT X SEC
	CALL	TIMER
	CALL	DIALPL0	;GO OFF HOOK & LISTEN FOR DIAL TONE
	JNC	DIALLPX	;GO REDIAL NUMBER
	JMP	DILAGN	;NO DIAL TONE HEARD

RBTIME:	CALL	CRLF
	JMP	RNGBK1	;HANGUP, REDIAL, & LISTEN FOR CARRIER


;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
	PUSH	B	;SAVE..
	PUSH	D	;..ACTIVE REG'S
	CALL	STAT	;KEYPRESS?
	ORA	A	;SET FLAGS
	CNZ	KEYIN	;YES, GET CHAR
	CPI	CAN	;^X?
	JZ	WAIT1	;YES, DISCONNECT, JMP TO MENU
	POP D		;RESTORE..
	POP B		;..REGS
	DCR C		;COUNT-DOWN
	JNZ	WAIT
	STC		;SET CARRY TO INDICATE MASK NOT SET
	RET

WAIT1:
	POP	D	;RESET..
	POP	B	;..STACK
	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:
	LDA	CRFLAG	;CONTINUOUS REDIAL FLAG
	ORA	A
	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
	CPI	'C'	;CONTINUOUS REDIAL?
	JNZ	DILAGN	;INVALID RESPONSE, ASK AGAIN
	XRA A ! CMA	;0FFH
	STA	CRFLAG	;CONTINUOUS REDIAL FLAG
 DILAGN0:
	MVI	B,50	;5 seconds wait for pmmi reset
	CALL	TIMER	;else busy tone may be sensed as dialtone
	CALL	DIALPL0	;WAIT FOR DIAL TONE
	JNC	DIALLP1	;DIAL NUMBER
	JMP	DILAGN	;NO DIAL TONE AFTER 10 SECS

CONMADE:
	CALL	ILPRT
DB	CR,LF,'Connection established - Select options: ',BELL,0
DILAGN1:
	CALL	STAT	;KEYPRESS?
	ORA	A	;SET FLAGS
	JNZ	GETCMD	;KEY PRESSED, GO GET OPTIONS
	MVI	A,BELL
	CALL	TYPE	;RING BELL
	LXI	B,2000H
DILAGN2:		;@7.32.........
	DCR	C
	JNZ	DILAGN2	;KILL SOME TIME FOR TERMINAL TO PROCESS BELL
	DCR	B
	JNZ	DILAGN2	;@7.32.........
	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
;
;****************************************************************
;* CRCSUBS (Cyclic Redundancy Code Subroutines) version 1.20	*
;* 8080 Mnemonics						*
;*								*
;*   These subroutines will compute and check a true 16-bit	*
;* Cyclic Redundancy Code for a message of arbitrary length.	*
;*								*
;* The  use  of this scheme will guarantee detection of all	*
;* single and double bit errors, all  errors  with  an  odd	*
;* number  of  error bits, all burst errors of length 16 or	*
;* less, 99.9969% of all 17-bit error bursts, and  99.9984%	*
;* of  all  possible  longer  error bursts.  (Ref: Computer	*
;* Networks, Andrew S.  Tanenbaum, Prentiss-Hall, 1981)		*
;*								*
;* Designed & coded by Paul Hansknecht, June 13, 1981		*
;*								*
;* Copyright (c) 1981, Carpenter Associates			*
;*		    Box 451					*
;*		    Bloomfield Hills, MI 48013			*
;*		    313/855-3074				*
;*								*
;* This program may be freely reproduced for non-profit use.	*
;*								*
;****************************************************************
;
;	ENTRY	CLRCRC,UPDCRC,FINCRC,CHKCRC
;
CLRCRC:	EQU	$	;Reset CRC Accumulator for a new message.
	PUSH	H
	LXI	H,0
	SHLD	CRCVAL
	POP	H
	RET
;
UPDCRC:	EQU	$	;Update CRC Accumulator using byte in (A).
	PUSH	PSW
	PUSH	B
	PUSH	H
	MVI	B,8
	MOV	C,A
	LHLD	CRCVAL
;
UPDLOOP: MOV	A,C
	RLC
	MOV	C,A
	MOV	A,L
	RAL
	MOV	L,A
	MOV	A,H
	RAL
	MOV	H,A
	JNC	SKIPIT
	MOV	A,H ;The generator is X^16 + X^12 + X^5 + 1
	XRI	10H ;as recommended by CCITT.
	MOV	H,A ;An alternate generator which is often
	MOV	A,L ;used in synchronous transmission protocols
	XRI	21H ;is X^16 + X^15 + X^2 + 1. This may be
	MOV	L,A ;used by substituting XOR 80H for XOR 10H
SKIPIT:	DCR	B   ;and XOR 05H for XOR 21H in the adjacent code.
	JNZ	UPDLOOP
	SHLD	CRCVAL
	POP	H
	POP	B
	POP	PSW
	RET
;
FINCRC:	EQU	$	; Finish CRC calc for outbound message.
	PUSH	PSW
	XRA	A
	CALL	UPDCRC
	CALL	UPDCRC
	PUSH	H
	LHLD	CRCVAL
	MOV	D,H
	MOV	E,L
	POP	H
	POP	PSW
	RET
;
CHKCRC:	EQU	$	; Check CRC bytes of received message.
	PUSH	H
	LHLD	CRCVAL
	MOV	A,H
	ORA	L
	POP	H
	RZ
	MVI	A,0FFH
	RET
;
CRCVAL:	DW	0
;
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
MENU2:	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
	lda	origsav	;@MODEM75.FIX
	sta	origflg	;@MODEM75.FIX
	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,20H		;FOOL THE SYSTEM'''
	STA	CMDBUF+4	;..CMDBUF SO THAT IT..
	JMP	DOOPT		;..LOOKS AT OPTION 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	MENU	;@MODEM75.FIX (was MENU1) - restore option tables

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 5, 'S', 'R', 'T', 'E', 'M'

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'
EPARITY:
	DB '0'	;EVEN PARITY SUB-OPTION - ONLY AVAILABLE IN 'S' AND 'R' MODES
OPARITY:
	DB '1'	;ODD PARITY SUB-OPTION - ONLY AVAILABLE IN 'S' AND 'R' MODES
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'
;	DB 'C'		;@7.41
	DB '0','1','B'

CRCFLG: DB 'C'	;use CRC instead of cksum	;@7.41 (moved)

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

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

BADOPT:	CALL	ILPRT
DB	'Invalid option',CR,LF,BELL,0
	JMP	MENU

FSTFLG:	DB TRUE
FIRSTME:
	DB	0FFH
		;first SOH received switch(it is zero after 1rst SOH)

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
origsav: ds	1	;@MODEM75.FIX
MODCTLB:
	DB	07FH
UARTCTLB:
	DB	ANSWMOD	; @7.5  (was previously ORIGMOD)

	DS	100
STACK:	DS	2
FCB3:	DS	33
FCBBUF:	DS	15
DBUF:		EQU	$	
NAMEBUF:	EQU	DBUF+(DBUFSIZ*1024)
		;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
FILSIZ		EQU	35
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