;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
;::: Micro Cornucopia Magazine                                       DmC:::
;::: PO Box 223			Thanks to Robert Aprato for getting     :::
;::: Bend Oregon 97709	 	us the source..This version orignally   :::
;:::                            modified for Kaypro by Earl F. Weener   :::
;:::                                                                    :::
;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
;
FALSE	EQU	0
TRUE	EQU	NOT FALSE
;
;-----------------------------------------------------
;	 --- Conditional Assembly Options ---	      ;
;------------------------------------------------------
;
;*** Kaypro runs standard CP/M ********************************************
;
STDCPM	EQU	TRUE	;TRUE, IS STANDARD CP/M
ALTCPM	EQU	FALSE	;TRUE, IS TRS-80 OR H8 W/O 0-ORG
;
;**************************************************************************
;*** This is a little confusing but must have EXTMOD true for Kaypro    ***
;*** operation even if for a DC Hayes (it is still external )           ***
;**************************************************************************
PMMI	EQU	FALSE   ;TRUE, IS PMMI                                  ***
DCH	EQU	FALSE	;TRUE, IS D.C. HAYES                            ***
H8	EQU	FALSE	;TRUE, IS H8/H89 W/INS8250 MODEM CHIP           ***
EXTMOD	EQU	TRUE	;TRUE, IS NONE OF THE ABOVE!                    ***
;**************************************************************************
;
;
NOCOMS	EQU	FALSE	;TRUE, NO .COM FILES SENT
NOLBS	EQU	TRUE	;TRUE, NO .??# FILES SENT
;
;**************************************************************************
;*** If ZCPR does not allow renaming then this will prevent twits from  ***
;***    sending a .COM file that could do nasties and running it        ***
;**************************************************************************
;
NOCOMR	EQU	FALSE	;TRUE, CHANGE.COM TO.OBJ ON RECEIVE
;
;**************************************************************************
;*** Have you done the speed up? If so this is true else false for vanilla
;*** Kaypro ***************************************************************
;
FASTCLK EQU	TRUE 	;PUT TRUE HERE FOR 4 MHZ CLOCK
;
FRNTPNL	EQU	FALSE	;TO DISPLAY STATUS ON FRONT PANEL
PANEL	EQU	0FFH	;DEFAULT ADDRESS OF FRONT PANEL
;
;**************************************************************************
;*** Set to true to keep incoming files private (with BYE user # limit) ***
;**************************************************************************
SETAREA	EQU	FALSE	;TRUE, IF USING DESIGNATED AREA TO RECEIVE 
RECU	EQU	9	;USER AREA TO REC IN (NOT GREATER THAN 9)
DEFDRV	EQU	'B'	;DRIVE TO REC TO
;
;**************************************************************************
;	FILE TRANSFER LOGGING OPTIONS	(J. Riley)                      *** 
; Sorry folks this requires a macro library that I don't have. Anybody  ***
; that finds a copy should send it in. "SEQIO22.???" (Send to MicroC)   ***
;**************************************************************************
LOGCAL	EQU	FALSE	;IF USING LOGGING OF XMODEM TRANSFERS
LASTUSR	EQU	15	;USER AREA OF 'LASTCALR' FILE (IF 'LOGCAL' ONLY)
;
;*** Set for BYE version 3 DmC 5/30/84 ************************************ 
LSPEED	EQU	TRUE	;REPORT DIFFERENCES IN BAUD RATES IN PRINTOUT
MSPEED	EQU	003CH	;LOCATION OF CURRENT BAUD RATE FACTOR(set by BYE)
;
;**************************************************************************
;*** I haven't tried this but i think it may cause problems if VOUT is  ***
;*** true. ****************************************************************
VOUT	EQU	FALSE	;TRUE, IF SECTOR COUNT TO CONSOLE
ECHOFLG	EQU	0008H	;ECHO ON/OFF FLAG FOR 'BYE', MUST BE AVAILABLE
			;IF USING VOUT.
;
;
;------------------------------------------------------
;	     --- Modem Port Equates --- 	      ;
;------------------------------------------------------
;
;
;If you are using an external modem (not S-100 plug-in)
;change these equates for your modem port requirements
;
;** Set up for Kaypro using serial data port ******************************
;
	IF	EXTMOD
MODCTLP EQU	06H	;PUT YOUR MODEM STATUS PORT HERE
MODSNDB EQU	04H	;YOUR BIT TO TEST FOR SEND
MODSNDR EQU	04H	;YOUR VALUE WHEN READY
MODRCVB EQU	01H	;YOUR BIT TO TEST FOR RECEIVE
MODRCVR EQU	01H	;YOUR VALUE WHEN READY
MODDCDB	EQU	08H	;CARRIER DETECT BIT
MODDCDA	EQU	08H	;VALUE WHEN ACTIVE
MODDATP EQU	04H	;YOUR MODEM DATA IN PORT
MODDATO	EQU	04H	;YOUR MODEM DATA OUT PORT
MODCTL2	EQU	06H	;SECOND CONTROL/STATUS PORT.
	ENDIF		;END OF EXTERNAL MODEM EQUATES
;
;		--- End of Options ---
;------------------------------------------------------
;
ERRLIM	EQU	10	;MAX ALLOWABLE ERRORS (10 STANDARD)
;
;Define ASCII characters used
;
SOH	EQU	1	;START OF HEADER
EOT	EQU	4	;END OF TRANSMISSION
ACK	EQU	6	;ACKNOWLEDGE
NAK	EQU	15H	;NEG ACKNOWLEDGE
CRC	EQU	'C'	;CRC REQUEST CHARACTER
CAN	EQU	18H	;CONTROL-X FOR CANCEL
LF	EQU	10	;LINEFEED
CR	EQU	13	;CARRIAGE RETURN
; 
	IF	STDCPM
BASE	EQU	0	;CP/M BASE ADDRESS
	ENDIF
;
	IF	ALTCPM
BASE	EQU	4200H	;ALTERNATE CP/M BASE ADDRESS
	ENDIF
;
	ORG	BASE+100H
;
;
;Init private stack
BEGIN	LXI	H,0	;HL=0
	DAD	SP	;HL=STACK FROM CP/M
	SHLD	STACK	;..SAVE IT
	LXI	SP,STACK ;SP=MY STACK
;
	if	setarea
	mvi	e,0ffh		;get the current user area	 a 01/06/82
	mvi	c,user						;a 01/06/82
	call	bdos						;a 01/06/82
	sta	olduser		;save user number here		 a 01/06/82
	mvi	c,curdrv	;get the current drive		 a 01/06/82
	call	bdos						;a 01/06/82
	sta	olddrv		;save drive here		 a 01/06/82
	endif
;
	CALL	ILPRT	;PRINT:
	DB	CR,LF
	DB	'XMODEM ver 5.1A [CRC capable] ',CR,LF,0
;
;GET OPTION
;
	LDA	FCB+2	;SECONDARY OPTION?
	CPI	'C'	;CRC CHECKING REQUESTED?
	JNZ	CHKOPTN	;NO, GO CHECK PRIMARY
	LDA	FCB+1	;GET PRIMARY OPTION
	CPI	'R'	;CRC VALID ONLY FOR RECEIVE
	JNZ	OPTNERR	;PRT MSG, ABORT
	XRA	A	;ZERO ACCUM
	STA	CRCFLG	;TURN ON CRC FLAG
;
CHKOPTN	LDA	FCB+1	;GET OPTION (S or R)
	PUSH	PSW	;SAVE OPTION
;
;Move the filename from FCB2 to FCB1
;
	CALL	MOVEFCB
;
;Gobble up garbage chars from the line
;prior to receive or send
;
	IN	MODDATP
	IN	MODDATP
;
;Jump to appropriate function
;
	POP	PSW	;GET OPTION
	IF	LOGCAL
	PUSH	PSW	;BUT SAVE IT
	ENDIF
;
	CPI	'S'	;SEND..
	JZ	SENDFIL ;..A FILE?
;
	CPI	'R'	;RECEIVE..
	JZ	RCVFIL	;..A FILE?
;
;Invalid option
;
OPTNERR	CALL	ERXIT	;EXIT W/ERROR
	DB	'++INVALID OPTION ON XMODEM '
	DB	'COMMAND++',CR,LF
	DB	'Must be S for SEND; R or RC '
	DB	'for RECEIVE',CR,LF,'$'

	IF	LOGCAL
	MACLIB SEQIO22

BSIZE	EQU	80H
FILERR	SET	EXIT
BUFFERS	SET	DBUF

;		THE FOLLOWING ALLOCATIONS ARE USED BY THE 'FILE' MACROS
DEFAULT$USER:
	DB	LASTUSR
CUR$USER:
	DB	0FFH
DEFAULT$DISK:
	DB	DEFDRV-'A'
CUR$DISK:
	DB	0FFH
PGSIZE:	DW	0

LOGCALL	FILE	INFILE,CALLERS,,LASTCALR,,BSIZE,,PUBLIC,TRUE
	MVI	A,RECU
	STA	DEFAULT$USER
	FILE	APPEND,LOG,,LOG,SYS,BSIZE,,PUBLIC,TRUE

	POP	PSW	; GET OPTION
	PUT	LOG	; PUT IT OUT TO LOG

	LDA	MSPEED	; GET SPEED FACTOR
	ADI	'0'-5	; MAGIC NUMBER FOR KAYPRO-II SO WE CAN
	PUT	LOG	; PUT OUT A SINGLE LETTER CODE
	MVI	A,' '	;
	PUT	LOG	;
	LDA	PGSIZE	; NOW THE PROGRAM SIZE(IN MINUTES TRANSFER TIME)
	CALL	PNDEC
	MVI	A,' '	; BLANK
	PUT	LOG

;			LOG THE DRIVE AND USER AREA AS A PROMPT
	LDA	FCB
	ORA	A
	JNZ	WDRV
	MVI	C,25
	CALL	@BDOS
	INR	A
WDRV:	ADI	'A'-1
	PUT	LOG

	MVI	C,32		; NOW THE USER AREA(AS DECIMAL NUMBER)
	MVI	E,0FFH
	CALL	@BDOS
	CALL	PNDEC
	MVI	A,'>'		; MAKE IT LOOK LIKE A PROMPT
	PUT	LOG

	LXI	H,FCB+1		; NOW THE NAME OF THE FILE
	MVI	B,11
	CALL	PUTSTR

	MVI	A,' '		; BLANK
	PUT	LOG

CLOOP:	GET	CALLERS		; AND THE CALLER
	CPI	EOF
	JZ	QUIT
	PUT	LOG
	JMP	CLOOP

PNDEC:	CPI	10		; TWO COLUMN DECIMAL FORMAT ROUTINE
	JC	ONE		; ONE OR TWO DIGITS TO AREA #?
	JMP	TWO
ONE:	PUSH	PSW
	MVI	A,'0'
	PUT	LOG
	POP	PSW
TWO:	MVI	H,0
	MOV	L,A
	CALL	DECOT
	RET

DECOT:	PUSH	B
	PUSH	D
	PUSH	H
	LXI	B,-10
	LXI	D,-1
;
DECOT2:	DAD	B
	INX	D
	JC	DECOT2
	LXI	B,10
	DAD	B
	XCHG
	MOV	A,H
	ORA	L
	CNZ	DECOT
	MOV	A,E
	ADI	'0'
	PUT	LOG
	POP	H
	POP	D
	POP	B
	RET

PUTSTR:	MOV	A,M
	PUSH	H
	PUSH	B
	PUT	LOG
	POP	B
	POP	H
	INX	H
	DCR	B
	JNZ	PUTSTR
	RET

QUIT:	FINIS	LOG
	JMP	EXIT
	ENDIF		; LOGCAL
;
* * * * * * * * * * * * * * * * * * * * *
*					*
*	SENDFIL: SENDS A CP/M FILE	*
*					*
* * * * * * * * * * * * * * * * * * * * *
;
;The CP/M file specified in the XMODEM command
;is transferred over the phone to another
;computer running MODEM with the "R" (receive)
;option.  The data is sent one sector at a
;time with headers and checksums, and re-
;transmission on errors.  
;
SENDFIL CALL	TRAP	;CHECK FOR NO NAME OR AMBIG. NAME
	CALL	CNREC	;COMPUTE # OF RECORDS.
	CALL	OPENFIL ;OPEN THE FILE
	MVI	E,80	;WAIT 80 SEC..
	CALL	WAITNAK ;..FOR INITIAL NAK
;
SENDLP	CALL	RDSECT	;READ A SECTOR
	JC	SENDEOF ;SEND EOF IF DONE
	CALL	INCRSNO ;BUMP SECTOR #
	XRA	A	;ZERO ERROR..
	STA	ERRCT	;..COUNT
;
SENDRPT CALL	SENDHDR ;SEND A HEADER
	CALL	SENDSEC ;SEND DATA SECTOR
	LDA	CRCFLG	;GET CRC FLAG
	ORA	A	;CRC IN EFFECT?
	CZ	SENDCRC	;YES, SEND CRC
	CNZ	SENDCKS ;NO, SEND CKSUM
	CALL	GETACK	;GET THE ACK
	JC	SENDRPT ;REPEAT IF NO ACK
	JMP	SENDLP	;LOOP UNTIL EOF
;
;File sent, send EOT's
;
SENDEOF MVI	A,EOT	;SEND..
	CALL	SEND	;..AN EOT
	CALL	GETACK	;GET THE ACK
	JC	SENDEOF ;LOOP IF NO ACK
	JMP	EXITLG	;ALL DONE
;
* * * * * * * * * * * * * * * * * * * * *
*					*
*	RCVFIL: RECEIVE A FILE		*
*					*
* * * * * * * * * * * * * * * * * * * * *
;
;Receives a file in block format as sent
;by another person doing "MODEM S FN.FT".
;Can be invoked by 'XMODEM R FN.FT' or
;by 'XMODEM RC FN.FT' if CRC is to be used.
;
RCVFIL	CALL	TRAP	;CHECK FOR NO NAME OR AMBIG. NAME
;
	IF	NOCOMR
	LXI	H,FCB+9 ;POINT TO FILETYPE
	MVI	A,'C'	;1ST LETTER
	CMP	M	;IS IT C ?
	JNZ	CONTINU ;IF NOT, CONTINUE NORMALLY
	INX	H	;GET 2ND LETTER
	MVI	A,'O'	;2ND LETTER
	CMP	M	;IS IT O ?
	JNZ	CONTINU ;IF NOT, CONTINUE NORMALLY
	INX	H	;GET 3RD LETTER
	MVI	A,'M'	;3RD LETTER
	CMP	M	;IS IT M ?
	JNZ	CONTINU ;IF NOT, CONTINUE NORMALLY

	CALL	ILPRT	; PRINT RENAMING MESSAGE
	DB	'Auto Renaming Filetype To ".OBJ" '
	DB	CR,LF,CR,LF,0
;
	LXI	H,OBJEXT
	LXI	D,FCB+9
	MVI	B,3
ALTEXT	MOV	A,M
	STAX	D
	INX	H
	INX	D
	DCR	B
	JNZ	ALTEXT
	JMP	CONTINU

OBJEXT	DB	'OBJ'
	ENDIF
;
CONTINU CALL	CHEKFIL ;SEE IF FILE EXISTS
	CALL	MAKEFIL ;..THEN MAKE NEW
	CALL	ILPRT	;PRINT:
;
	if	setarea
	db	'NOTE: File Will Be Received On',cr,lf	;	     a 01/06/81
	db	'Drive ',defdrv,' User ',recu+30H,cr,lf	; tell this .a 01/06/81
	endif
;
	DB	'FILE OPEN - READY TO RECEIVE',CR,LF,0
;
RCVLP	CALL	RCVSECT ;GET A SECTOR
	JC	RCVEOT	;GOT EOT
	CALL	WRSECT	;WRITE THE SECTOR
	CALL	INCRSNO ;BUMP SECTOR #
	CALL	SENDACK ;ACK THE SECTOR
	JMP	RCVLP	;LOOP UNTIL EOF
;
;Got EOT on sector - flush buffers, end
;
RCVEOT	CALL	WRBLOCK ;WRITE THE LAST BLOCK
	CALL	SENDACK ;ACK THE SECTOR
	CALL	CLOSFIL ;CLOSE THE FILE
	JMP	EXITLG	;ALL DONE
;
* * * * * * * * * * * * * * * * * * * * *
*					*
*		SUBROUTINES		*
*					*
* * * * * * * * * * * * * * * * * * * * *
;
;---->	TRAP: Check for no file name or ambiguous name
;
TRAP	LXI	H,FCB+1 ;POINT TO FILE NAME
	MOV	A,M	;GET FIRST CHAR OF FILE NAME
	CPI	' '	;ANY THERE?
	JNZ	ATRAP	;YES, CHECK FOR AMBIGOUS FILE NAME
	CALL	ERXIT	;PRINT MSG, EXIT
	DB	'++NO FILE NAME SPECIFIED++',CR,LF,'$'
;
ATRAP	MVI	B,11	;11 CHARS TO CHECK
;
TRLOOP	MOV	A,M	;GET CHAR FROM FCB
	CPI	'?'	;AMBIGUOUS?
	JZ	TRERR	;YES, EXIT WITH ERROR MSG
	INX	H	;POINT TO NEXT CHAR
	DCR	B	;ONE LESS TO GO
	JNZ	TRLOOP	;NOT DONE, CHECK SOME MORE
	RET		;NO AMBIGUOUS NAME, RETURN
;
TRERR	CALL	ERXIT	;PRINT MSG, EXIT
	DB	'++CAN''T USE WILD CARD OPTIONS++',CR,LF,'$'
;
;---->	RCVSECT: Receive a sector
;
;Returns with carry set if EOT received.
;
RCVSECT XRA	A	;GET 0
	STA	ERRCT	;INIT ERROR COUNT
;
RCVRPT:
	IF	PMMI OR H8 OR DCH
	XRA	A	;GET 0
	STA	ERRCDE	;CLEAR RECEIVE ERROR CODE
	ENDIF
;
	MVI	B,10	;10 SEC TIMEOUT
	CALL	RECV	;GET SOH/EOT
	JC	RCVSTOT ;TIMEOUT
;
	IF	PMMI OR H8 OR DCH
	CALL	RCVERR	;TRANS ERROR?
	JC	RCVSERR	;CARRY SET IF ERROR
	ENDIF
;
	CPI	SOH	;GET SOH?
	JZ	RCVSOH	;..YES
;
;Earlier versions of MODEM program send some nulls -
;ignore them
;
	ORA	A	;00 FROM SPEED CHECK?
	JZ	RCVRPT	;YES, IGNORE IT
	CPI	EOT	;END OF TRANSFER?
	STC		;RETURN WITH CARRY..
	RZ		;..SET IF EOT
;
;Didn't get SOH or EOT - 
;	-or-
;Didn't get valid header - purge the line,
;then send NAK.
;
RCVSERR MVI	B,1	;WAIT FOR 1 SEC..
	CALL	RECV	;..WITH NO CHARS
	JNC	RCVSERR ;LOOP UNTIL SENDER DONE
	LDA	CRCFLG	;GET CRC FLAG
	ORA	A	;CRC IN EFFECT?
	MVI	A,NAK	;PUT NAK IN ACCUM
	JNZ	RCVSER2	;NO, SEND THE NAK
	LDA	FIRSTIME;GET FIRST TIME SWITCH
	ORA	A	;HAS FIRST SOH BEEN RECEIVED?
	MVI	A,NAK	;PUT NAK IN ACCUM
	JZ	RCVSER2	;YES, THEN SEND NAK
	MVI	A,CRC	;TELL SENDER CRC IS IN EFFECT
;
RCVSER2	CALL	SEND	;..THE NAK or CRC request
	LDA	ERRCT	;ABORT IF..
	INR	A	;..WE HAVE REACHED..
	STA	ERRCT	;..THE ERROR..
	CPI	ERRLIM	;..LIMIT?
	JC	RCVRPT	;..NO, TRY AGAIN
;
;10 errors in a row -
;
RCVSABT CALL	CLOSFIL ;KEEP WHATEVER WE GOT
	CALL	ILPRT
	DB	'++UNABLE TO RECEIVE BLOCK '
	DB	'- ABORTING++',CR,LF,0
	CALL	DELFILE	;DELETE RECEIVED FILE			; v48c smh
	CALL	ILPRT	;PRINT SECOND HALF OF MESSAGE
	DB	'++INCOMPLETELY RECEIVED FILE '
	DB	'DELETED++',CR,LF,0
	JMP	EXIT	;GIVE UP
;
;---->	DELFILE: Deletes the received file (used if receive aborts)
;							; v48c smh
DELFILE LXI	D,FCB	;POINT TO FILE			; (whole routine)
	MVI	C,ERASEF ;GET FUNCTION
	CALL	BDOS	;DELETE IT
	INR	A	;DELETE OK?
	RNZ		;..YES, RETURN
	CALL	ERXIT	;..NO, ABORT
	DB	'++CAN''T DELETE RECEIVED FILE++',CR,LF,'$',0
;
;Timed out on receive
;
RCVSTOT JMP	RCVSERR ;BUMP ERR CT, ETC.
;
;---->RCVERR: Checks to see if framing error, overrun, or
;		parity error occurred.
;	1. Error code (ERRCDE) was set in recv routine
;	2. ERRCDE=0 for no errors, ERRCDE<>0 for errors
;	3. If there has been an error, this routine sets
;		the carry bit on.
;
	IF	PMMI OR H8 OR DCH
RCVERR	PUSH	PSW	;SAVE CHAR TRANSMITTED
	LDA	ERRCDE	;GET RECEIVE ERR CODE
	ANA	A	;IS IT ZERO?
	JZ	RCVERR2	;YES, NO ERROR
	POP	PSW	;RESTORE CHAR TRANSMITTED
	STC		;SET CARRY ON FOR ERROR
	RET
;
RCVERR2	POP	PSW	;RESTORE CHAR TRANSMITTED
	ORA	A	;CLEAR CARRY BIT
	RET
	ENDIF
;
;Got SOH - get block #, block # complemented
;
RCVSOH	XRA	A	;ZERO ACCUM
	STA	FIRSTIME;INDICATE FIRST SOH RECV'D
	MVI	B,1	;TIMEOUT = 1 SEC
	CALL	RECV	;GET SECTOR
	JC	RCVSTOT ;GOT TIMEOUT
;
	IF	PMMI OR H8 OR DCH
	CALL	RCVERR	;TRANS ERROR?
	JC	RCVSERR	;CARRY SET IF ERROR
	ENDIF
;
	MOV	D,A	;D=BLK #
	MVI	B,1	;TIMEOUT = 1 SEC
	CALL	RECV	;GET CMA'D SECT #
	JC	RCVSTOT ;TIMEOUT
;
	IF	PMMI OR H8 OR DCH
	CALL	RCVERR	;TRANS ERROR?
	JC	RCVSERR	;CARRY SET IF ERROR
	ENDIF
;
	CMA		;CALC COMPLEMENT
	CMP	D	;GOOD SECTOR #?
	JZ	RCVDATA ;YES, GET DATA
;
;Got bad sector #
;
	JMP	RCVSERR ;BUMP ERROR CT.
;
RCVDATA MOV	A,D	;GET SECTOR #
	STA	RCVSNO	;SAVE IT
	MVI	C,0	;INIT CKSUM
	CALL	CLRCRC	;CLEAR CRC COUNTER
	LXI	H,BASE+80H ;POINT TO BUFFER
;
RCVCHR	MVI	B,1	;1 SEC TIMEOUT
	CALL	RECV	;GET CHAR
	JC	RCVSTOT ;TIMEOUT
;
	IF	PMMI OR H8 OR DCH
	CALL	RCVERR	;TRANS ERROR?
	JC	RCVSERR	;CARRY SET IF ERROR
	ENDIF
;
	MOV	M,A	;STORE CHAR
	INR	L	;DONE?
	JNZ	RCVCHR	;NO, LOOP
	LDA 	CRCFLG	;GET CRC FLAG
	ORA	A	;CRC IN EFFECT?
	JZ	RCVCRC	;YES, TO RECEIVE CRC
;
;Verify checksum
;
	MOV	D,C	;SAVE CHECKSUM
	MVI	B,1	;TIMEOUT LEN.
	CALL	RECV	;GET CHECKSUM
	JC	RCVSTOT ;TIMEOUT
;
	IF	PMMI OR H8 OR DCH
	CALL	RCVERR	;TRANS ERROR?
	JC	RCVSERR	;CARRY SET IF ERROR
	ENDIF
;
	CMP	D	;CHECKSUM OK?
	JNZ	RCVSERR ;NO, ERROR
;
;Got a sector, it's a duplicate if = previous,
;	or OK if = 1 + previous sector
;
CHKSNUM	LDA	RCVSNO	;GET RECEIVED
	MOV	B,A	;SAVE IT
	LDA	SECTNO	;GET PREV
	CMP	B	;PREV REPEATED?
	JZ	RECVACK ;ACK TO CATCH UP
	INR	A	;CALC NEXT SECTOR #
	CMP	B	;MATCH?
	JNZ	ABORT	;NO MATCH - STOP SENDER, EXIT
	RET		;CARRY OFF - NO ERRORS
;
;---->	RCVCRC:	Receive the cyclic redundancy check
;		characters (2 bytes), and see if the crc
;		received matches the one calculated.
;		If they match, get next sector, elselc the crc
	ADD	C	;CALC CKSUM
	MOV	C,A	;SAVE CKSUM
;
	IF	NOT DCH
SENDW	IN	MODCTLP ;GET STATUS
	ENDIF
;
	IF	DCH
SENDW	IN	MODCTL2 ;GET STATUS
	ENDIF
;
	IF	PMMI AND FRNTPNL
	OUT	PANEL	;DISPLAY STATUS
	ENDIF
;
	ANI	MODSNDB ;ISOLATE READY BIT
	CPI	MODSNDR ;READY?
	JZ	SENDR	;..YES, GO SEND
;
;Xmit status not ready, so test for carrier before
;looping - if lost, go to CARCK and give it up to 15
;seconds to return. If it doesn't return abort via
;EXIT.
;
	PUSH	D	;Save D,E
;
	IF	EXTMOD OR H8 OR DCH
	IN	MODCTL2	;READ MODEM STATUS
	ENDIF
;
	IF	PMMI
	IN	BAUDRP	;READ MODEM STATUS
	ENDIF
;
	IF	PMMI AND FRNTPNL
	OUT	PANEL	;DISPLAY STATUS
	ENDIF
;
	ANI	MODDCDB	;CARRIER DETECT MASK
	CPI	MODDCDA	;IS IT STILL ON?
	CNZ	CARCK	;IF NOT, CONTINUE TESTING IT
	POP	D	;RESTORE D,E
	JMP	SENDW	;ELSE, WAIT FOR XMIT READY.
;
;Xmit status ready, carrier still on - send the data.
;
SENDR	POP	PSW	;GET CHAR
	OUT	MODDATP ;OUTPUT IT
	RET		;FROM "SEND"
;
;---->	WAITNAK: Waits for initial NAK
;
;To ensure no data is sent until the receiving
;program is ready, this routine waits for the
;first timeout-NAK or the letter 'C' for CRC
;from the receiver.  If CRC is in effect, then
;Cyclic Redundancy Checks are used instead of
;checksums.
;(E) contains the # of seconds to wait.
;
; If the first character received is a CAN (control-X)
; then the send will be aborted as though it had timed out.
; 04/01/82 BHK 
;
WAITNAK MVI	B,1	;TIMEOUT DELAY
	CALL	RECV	;DID WE GET..
	CPI	NAK	;..A NAK?
	RZ		;YES, SEND BLOCK
	CPI	CRC	;CRC INDICATED?
	JZ	WAITCRC	;YES, GO PUT CRC IN EFFECT
	CPI	CAN	;WAS IT A CANCEL (CONTROL-X)?		; v48c bhk
	JZ	ABORT	;YES, ABORT				; v48c bhk
	DCR	E	;80 TRIES?
	JZ	ABORT	;YES, ABORT
	JMP	WAITNAK ;NO, LOOP
;
;----> WAITCRC: Turn on CRC Flag
;
WAITCRC	XRA	A	;ZERO ACCUM
	STA	CRCFLG	;TURN ON CRC OPT
	RET
;
;---->	MOVEFCB: Moves FCB(2) to FCB
;
;In order to make the XMODEM command 'natural',
;i.e. XMODEM SEND FILENAME (MODEM S FN.FT) rather
;than XMODEM FILENAME SEND S
	ENDIF
;
	IF	DCH
	IN	MODCTL2	;GET MODEM STATUS
	ENDIF
;
	IF	PMMI OR H8 OR DCH
	MOV	D,A	;SAVE STATUS
	ANI	MODFRME	;FRAMING ERROR?
	CPI	MODFRME
	JNZ	MCHAR2	;NO, CHECK FOR OVERRUN
	LDA	ERRCDE	;GET RECV ERR CODE
	ORI	MODFRME	;TURN ON RECV ERR GODE
	STA	ERRCDE	;PUT IT BACK
;
MCHAR2:	MOV	A,D	;RESTORE MODEM STATUS
	ANI	MODOVRE	;OVERRUN?
	CPI	MODOVRE
	JNZ	MCHAR3	;NO, CHECK FOR PARITY ERROR
	LDA	ERRCDE
	ORI	MODOVRE	;TURN ON RECV ERR CODE
	STA	ERRCDE
;
MCHAR3:	MOV	A,D	;RESTORE MODEM STATUS
	ANI	MODPARE	;PARITY ERROR?
	CPI	MODPARE
	JNZ	MCHAR4	;NO, GET DATA CHAR
	LDA	ERRCDE
	ORI	MODPARE
	STA	ERRCDE
;
MCHAR4:
	ENDIF		;PMMI OR H8 OR DCH
;
;Get data char
;
	IN	MODDATP ;READ THE CHAR
	POP	D	;RESTORE DE
;
;Calc checksum and CRC
;
	PUSH	PSW	;SAVE THE CHAR
	CALL	UPDCRC	;CALC CRC
	ADD	C	;ADD TO CHECKSUM
	MOV	C,A	;SAVE CHECKSUM
	POP	PSW	;RESTORE CHAR
	ORA	A	;CARRY OFF: NO ERROR
	RET		;FROM "RECV"
;
;CARCK - common 15 second carrier test for RECV and
;SEND. If carrier returns within 15 seconds, normal
;program execution continues. Else, it will abort
;to CP/M via EXIT.
;
CARCK	MVI	E,150	;VALUE FOR 15 SECOND DELAY
;
CARCK1	CALL	DELAY	;KILL .1 SECONDS
;
	IF	EXTMOD OR H8 OR DCH
	IN	MODCTL2	;READ MODEM STATUS
	ENDIF
;
	IF	PMMI
	IN	BAUDRP	;READ MODEM STATUS
	ENDIF
;
	IF	PMMI AND FRNTPNL
	OUT	PANEL	;DISPLAY STATUS
	ENDIF
;
	ANI	MODDCDB	;CARRIER DETECT MASK
	CPI	MODDCDA	;IS IT STILL ON?
	RZ		;RETURN IF CARRIER ON
	DCR	E	;HAS 15 SECONDS EXPIRED?
	JNZ	CARCK1	;IF NOT, CONTINUE TESTING
	JMP	EXIT	;ELSE, ABORT TO CP/M.
;
;DELAY - 100 millisecond delay.
;
DELAY	PUSH	B	;SAVE B,C
;
	IF	FASTCLK	;IF 4MHZ CLOCK
	LXI	B,16667	;VALUE FOR 100MS DELAY
	ENDIF
;
	IF	NOT FASTCLK
	LXI	B,8334	;VALUE FOR 100MS DELAY
	ENDIF
;
DELAY2	DCX	B	;UPDATE COUNT
	MOV	A,B	;GET MS BYTE
	ORA	C	;COUNT = ZERO?
	JNZ	DELAY2	;IF NOT, CONTINUE
	POP	B	;RESTORE B,C
	RET		;RETURN TO CARCK1.
;
;---->	SEND: Send a character to the modem
;
SEND	PUSH	PSW	;SAVE THE CHARACTER
	CALL	UPDCRC	;ca
	JNZ	DKWRLP	;..YES, LOOP
	XRA	A	;GET A ZERO
	STA	SECINBF ;RESET # OF SECTORS
	LXI	H,DBUF	;RESET BUFFER..
	SHLD	SECPTR	;..POINTER
;
RSDMA	LXI	D,BASE+80H ;RESET..
	MVI	C,STDMA ;..DMA..
	CALL	BDOS	;..ADDR
	RET
;
WRERR	CALL	RSDMA	;RESET DMA TO NORM.
	MVI	C,CAN	;CANCEL..
	CALL	SEND	;..SENDER
	CALL	ERXIT	;EXIT W/MSG:
	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	$	;RECEIVE W/GARBAGE DELETE
	IN	MODDATP ;GET A CHAR
	IN	MODDATP ;..TOTALLY PURGE UART
;
RECV	PUSH	D	;SAVE
;
	IF	FASTCLK ;4MHZ?
	MOV	A,B	;GET TIME REQUEST
	ADD	A	;DOUBLE IT
	MOV	B,A	;NEW TIME IN B
	ENDIF
;
MSEC	LXI	D,50000 ;1 SEC DCR COUNT
;
	IF	NOT DCH
MWTI	IN	MODCTLP ;CHECK STATUS
	ENDIF
;
	IF	DCH
MWTI	IN	MODCTL2 ;CHECK STATUS
	ENDIF
;
	IF	PMMI AND FRNTPNL
	OUT	PANEL	;DISPLAY STATUS ON PANEL LIGHTS
	ENDIF
;
	ANI	MODRCVB ;ISOLATE BIT
	CPI	MODRCVR ;READY?
	JZ	MCHAR	;GOT CHAR
	DCR	E	;COUNT..
	JNZ	MWTI	;..DOWN..
	DCR	D	;..FOR..
	JNZ	MWTI	;..TIMEOUT
	DCR	B	;MORE SECONDS?
	JNZ	MSEC	;YES, WAIT
;
;Test for the presence of carrier - if none, go to 
;CARCK and continue testing for 15 seconds. If carrier
;returns, continue. If is doesn't return, exit.
;
	IF	EXTMOD OR H8 OR DCH
	IN	MODCTLP	;READ MODEM STATUS
	ENDIF
;
	IF	PMMI
	IN	BAUDRP	;READ MODEM STATUS
	ENDIF
;
	IF	PMMI AND FRNTPNL
	OUT	PANEL	;DISPLAY STATUS ON PANEL LIGHTS
	ENDIF
;
	ANI	MODDCDB	;CARRIER DETECT MASK
	CPI	MODDCDA	;IS IT STILL ON?
	CNZ	CARCK	;IF NOT, TEST FOR 15 SECONDS
;
;Modem timed out receiving - but carrier still on.
;
	POP	D	;RESTORE D,E
	STC		;CARRY SHOWS TIMEOUT
	RET
;
;Got character from modem
;
MCHAR:
;Check to see if there was a framing error,
;overrun, or parity error.
;
	IF	PMMI OR H8
	IN	MODCTL2	;GET MODEM STATU	LXI	D,BASE+80H ;TO DATA
	CALL	MOVE128 ;MOVE TO BUFFER
	SHLD	SECPTR	;SAVE BUFFER POINTER
	RET		;FROM "READSEC"
;
;Buffer is empty - read in another block of 16
;
RDBLOCK LDA	EOFLG	;GED EOF FLAG
	CPI	1	;IS IT SET?
	STC		;TO SHOW EOF
	RZ		;GOT EOF
	MVI	C,0	;SECTORS IN BLOCK
	LXI	D,DBUF	;TO DISK BUFFER
;
RDSECLP PUSH	B
	PUSH	D
	MVI	C,STDMA ;SET DMA..
	CALL	BDOS	;..ADDR
	LXI	D,FCB
	MVI	C,READ
	CALL	BDOS
	POP	D
	POP	B
	ORA	A	;READ OK?
	JZ	RDSECOK ;YES
	DCR	A	;EOF?
	JZ	REOF	;GOT EOF
;
;Read error
;
	CALL	ERXIT
	DB	'++FILE READ ERROR++',CR,LF,'$'
;
RDSECOK LXI	H,80H	;ADD LENGTH OF ONE SECTOR...
	DAD	D	;...TO NEXT BUFF
	XCHG		;BUFF TO DE
	INR	C	;MORE SECTORS?
	MOV	A,C	;GET COUNT
	CPI	16	;DONE?
	JZ	RDBFULL ;..YES, BUFF IS FULL
	JMP	RDSECLP ;READ MORE
;
REOF	MVI	A,1
	STA	EOFLG	;SET EOF FLAG
	MOV	A,C
;
;Buffer is full, or got EOF
;
RDBFULL STA	SECINBF ;STORE SECTOR COUNT
	LXI	H,DBUF	;INIT BUFFER..
	SHLD	SECPTR	;..POINTER
	LXI	D,BASE+80H ;RESET..
	MVI	C,STDMA ;..DMA..
	CALL	BDOS	;..ADDR
	JMP	RDSECT	;PASS SECT TO CALLER
;
;---->	WRSECT: Write a sector
;
;Writes the sector into a buffer.  When 16
;have been written, writes the block to disk.
;
;Entry point "WRBLOCK" flushes the buffer at EOF.
;
WRSECT	LHLD	SECPTR	;GET BUFF ADDR
	XCHG		;TO DE FOR MOVE
	LXI	H,BASE+80H	;FROM HERE
	CALL	MOVE128 ;MOVE TO BUFFER
	XCHG		;SAVE NEXT..
	SHLD	SECPTR	;..BLOCK POINTER
	LDA	SECINBF ;BUMP THE..
	INR	A	;..SECTOR #..
	STA	SECINBF ;..IN THE BUFF
	CPI	16	;HAVE WE 16?
	RNZ		;NO, RETURN
;
;---->	WRBLOCK: Writes a block to disk
;
WRBLOCK LDA	SECINBF ;# SECT IN BUFFER
	ORA	A	;0 MEANS END OF FILE
	RZ		;NONE TO WRITE
	MOV	C,A	;SAVE COUNT
	LXI	D,DBUF	;POINT TO DISK BUFF
;
DKWRLP	PUSH	H
	PUSH	D
	PUSH	B
	MVI	C,STDMA ;SET DMA
	CALL	BDOS	;TO BUFFER
	LXI	D,FCB	;THEN WRITE
	MVI	C,WRITE ;..THE..
	CALL	BDOS	;..BLOCK
	POP	B
	POP	D
	POP	H
	ORA	A
	JNZ	WRERR	;OOPS, ERROR
	LXI	H,80H	;LENGTH OF 1 SECT
	DAD	D	;HL= NEXT BUFF
	XCHG		;TO DE FOR SETDMA
	DCR	C	;MORE SECTORS?(MODEM FN.FT S), this
;routine moves the filename from the second FCB
;to the first.
;
MOVEFCB LXI	H,FCB+16 ;FROM
	LXI	D,FCB	;TO
	MVI	B,16	;LEN
	CALL	MOVE	;DO THE MOVE
	XRA	A	;GET 0
	STA	FCBSNO	;ZERO SECTOR #
	STA	FCBEXT	;..AND EXTENT
	RET
;
CTYPE	PUSH	B	;SAVE..
	PUSH	D	;..ALL..
	PUSH	H	;..REGS
	MOV	E,A	;CHAR TO E
	MVI	C,WRCON ;GET BDOS FNC
	CALL	BDOS	;PRIN THE CHR
	POP	H	;RESTORE..
	POP	D	;..ALL..
	POP	B	;..REGS
	RET		;FROM "CTYPE"
;
HEXO	PUSH	PSW	;SAVE FOR RIGHT DIGIT
	RAR		;RIGHT..
	RAR		;..JUSTIFY..
	RAR		;..LEFT..
	RAR		;..DIGIT..
	CALL	NIBBL	;PRINT LEFT DIGIT
	POP	PSW	;RESTORE RIGHT
;
NIBBL	ANI	0FH	;ISOLATE DIGIT
	CPI	10	;IS IT <10?
	JC	ISNUM	;YES, NOT ALPHA
	ADI	7	;ADD ALPHA BIAS
;
ISNUM	ADI	'0'	;MAKE PRINTABLE
	JMP	CTYPE	;..THEN TYPE IT
;
;---->	ILPRT: Inline print of message
;
;The call to ILPRT is followed by a message,
;binary 0 as the end.
;
ILPRT	XTHL		;SAVE HL, GET HL=MSG
;
ILPLP	MOV	A,M	;GET CHAR
	ORA	A	;END OF MSG?
	JZ	ILPRET	;..YES, RETURN
	CALL	CTYPE	;TYPE THE MSG
	INX	H	;TO NEXT CHAR
	JMP	ILPLP	;LOOP
;
ILPRET	XTHL		;RESTORE HL
	RET		;PAST MSG
;
EXITLG				; SPECIAL LOG CALLER EXIT
	IF	LOGCAL
	JMP	LOGCALL
	ENDIF
	JMP	EXIT
;
;---->	ERXIT: Exit printing message following call
;
ERXIT	POP	D	;GET MESSAGE
	MVI	C,PRINT ;GET BDOS FNC
	CALL	BDOS	;PRINT MESSAGE
;
EXIT	LHLD	STACK	;GET ORIGINAL STACK
	SPHL		;RESTORE IT
;
	IF VOUT			;
	PUSH	PSW		;
	MVI	A,0FFH		;FORCE ECHO-ON.
	STA	ECHOFLG		;
	POP	PSW		;
	ENDIF	;VOUT
;
	if	setarea
	call	restu		; restore old area user & drive ..a 01/06/81
	endif
;
	RET		;--EXIT-- TO CP/M
;
	if	setarea
;
;------> RESTORE THE OLD USER AREA AND DRIVE FROM A RECEIVED FILE
;
RESTU	lda	olddrv		;RESTORE THE OLD DRIVE		;a 01/06/81
	mov	e,a						;a 01/06/81
	call	recdrx						;a 01/06/81
	lda	olduser		;RESTORE THE OLD USER NUMBER	;a 01/06/81
	mov	e,a						;a 01/06/81
	jmp	recare						;a 01/06/91
;
;--------> SET USER AREA TO RECEIVE FILE
RECAREA	call	recdrv		;ok set the drive to its place	;a	LXI	D,BASE+80H ;TO DATA
	CALL	MOVE128 ;MOVE TO BUFFER
	SHLD	SECPTR	;SAVE BUFFER POINTER
	RET		;FROM "READSEC"
;
;Buffer is empty - read in another block of 16
;
RDBLOCK LDA	EOFLG	;GED EOF FLAG
	CPI	1	;IS IT SET?
	STC		;TO SHOW EOF
	RZ		;GOT EOF
	MVI	C,0	;SECTORS IN BLOCK
	LXI	D,DBUF	;TO DISK BUFFER
;
RDSECLP PUSH	B
	PUSH	D
	MVI	C,STDMA ;SET DMA..
	CALL	BDOS	;..ADDR
	LXI	D,FCB
	MVI	C,READ
	CALL	BDOS
	POP	D
	POP	B
	ORA	A	;READ OK?
	JZ	RDSECOK ;YES
	DCR	A	;EOF?
	JZ	REOF	;GOT EOF
;
;Read error
;
	CALL	ERXIT
	DB	'++FILE READ ERROR++',CR,LF,'$'
;
RDSECOK LXI	H,80H	;ADD LENGTH OF ONE SECTOR...
	DAD	D	;...TO NEXT BUFF
	XCHG		;BUFF TO DE
	INR	C	;MORE SECTORS?
	MOV	A,C	;GET COUNT
	CPI	16	;DONE?
	JZ	RDBFULL ;..YES, BUFF IS FULL
	JMP	RDSECLP ;READ MORE
;
REOF	MVI	A,1
	STA	EOFLG	;SET EOF FLAG
	MOV	A,C
;
;Buffer is full, or got EOF
;
RDBFULL STA	SECINBF ;STORE SECTOR COUNT
	LXI	H,DBUF	;INIT BUFFER..
	SHLD	SECPTR	;..POINTER
	LXI	D,BASE+80H ;RESET..
	MVI	C,STDMA ;..DMA..
	CALL	BDOS	;..ADDR
	JMP	RDSECT	;PASS SECT TO CALLER
;
;---->	WRSECT: Write a sector
;
;Writes the sector into a buffer.  When 16
;have been written, writes the block to disk.
;
;Entry point "WRBLOCK" flushes the buffer at EOF.
;
WRSECT	LHLD	SECPTR	;GET BUFF ADDR
	XCHG		;TO DE FOR MOVE
	LXI	H,BASE+80H	;FROM HERE
	CALL	MOVE128 ;MOVE TO BUFFER
	XCHG		;SAVE NEXT..
	SHLD	SECPTR	;..BLOCK POINTER
	LDA	SECINBF ;BUMP THE..
	INR	A	;..SECTOR #..
	STA	SECINBF ;..IN THE BUFF
	CPI	16	;HAVE WE 16?
	RNZ		;NO, RETURN
;
;---->	WRBLOCK: Writes a block to disk
;
WRBLOCK LDA	SECINBF ;# SECT IN BUFFER
	ORA	A	;0 MEANS END OF FILE
	RZ		;NONE TO WRITE
	MOV	C,A	;SAVE COUNT
	LXI	D,DBUF	;POINT TO DISK BUFF
;
DKWRLP	PUSH	H
	PUSH	D
	PUSH	B
	MVI	C,STDMA ;SET DMA
	CALL	BDOS	;TO BUFFER
	LXI	D,FCB	;THEN WRITE
	MVI	C,WRITE ;..THE..
	CALL	BDOS	;..BLOCK
	POP	B
	POP	D
	POP	H
	ORA	A
	JNZ	WRERR	;OOPS, ERROR
	LXI	H,80H	;LENGTH OF 1 SECT
	DAD	D	;HL= NEXT BUFF
	XCHG		;TO DE FOR SETDMA
	DCR	C	;MORE SECTORS?
	JNZ	DKWRLP	;..YES, LOOP
	XRA	A	;GET A ZERO
	STA	SECINBF ;RESET # OF SECTORS
	LXI	H,DBUF	;RESET BUFFER..
	SHLD	SECPTR	;..POINTER
;
RSDMA	LXI	D,BASE+80H ;RESET..
	MVI	C,STDMA ;..DMA..
	CALL	BDOS	;..ADDR
	RET
;
WRERR	CALL	RSDMA	;RESET DMA TO NORM.
	MVI	C,CAN	;CANCEL..
	CALL	SEND	;..SENDER
	CALL	ERXIT	;EXIT W/MSG:
	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	$	;RECEIVE W/GARBAGE DELETE
	IN	MODDATP ;GET A CHAR
	IN	MODDATP ;..TOTALLY PURGE UART
;
RECV	PUSH	D	;SAVE
;
	IF	FASTCLK ;4MHZ?
	MOV	A,B	;GET TIME REQUEST
	ADD	A	;DOUBLE IT
	MOV	B,A	;NEW TIME IN B
	ENDIF
;
MSEC	LXI	D,50000 ;1 SEC DCR COUNT
;
	IF	NOT DCH
MWTI	IN	MODCTLP ;CHECK STATUS
	ENDIF
;
	IF	DCH
MWTI	IN	MODCTL2 ;CHECK STATUS
	ENDIF
;
	IF	PMMI AND FRNTPNL
	OUT	PANEL	;DISPLAY STATUS ON PANEL LIGHTS
	ENDIF
;
	ANI	MODRCVB ;ISOLATE BIT
	CPI	MODRCVR ;READY?
	JZ	MCHAR	;GOT CHAR
	DCR	E	;COUNT..
	JNZ	MWTI	;..DOWN..
	DCR	D	;..FOR..
	JNZ	MWTI	;..TIMEOUT
	DCR	B	;MORE SECONDS?
	JNZ	MSEC	;YES, WAIT
;
;Test for the presence of carrier - if none, go to 
;CARCK and continue testing for 15 seconds. If carrier
;returns, continue. If is doesn't return, exit.
;
	IF	EXTMOD OR H8 OR DCH
	IN	MODCTLP	;READ MODEM STATUS
	ENDIF
;
	IF	PMMI
	IN	BAUDRP	;READ MODEM STATUS
	ENDIF
;
	IF	PMMI AND FRNTPNL
	OUT	PANEL	;DISPLAY STATUS ON PANEL LIGHTS
	ENDIF
;
	ANI	MODDCDB	;CARRIER DETECT MASK
	CPI	MODDCDA	;IS IT STILL ON?
	CNZ	CARCK	;IF NOT, TEST FOR 15 SECONDS
;
;Modem timed out receiving - but carrier still on.
;
	POP	D	;RESTORE D,E
	STC		;CARRY SHOWS TIMEOUT
	RET
;
;Got character from modem
;
MCHAR:
;Check to see if there was a framing error,
;overrun, or parity error.
;
	IF	PMMI OR H8
	IN	MODCTL2	;GET MODEM STATUS
	ENDIF
;
	IF	DCH
	IN	MODCTL2	;GET MODEM STATUS
	ENDIF
;
	IF	PMMI OR H8 OR DCH
	MOV	D,A	;SAVE STATUS
	ANI	MODFRME	;FRAMING ERROR?
	CPI	MODFRME
	JNZ	MCHAR2	;NO, CHECK FOR OVERRUN
	LDA	ERRCDE	;GET RECV ERR CODE
	ORI	MODFRME	;TURN ON RECV ERR GODE
	STA	ERRCDE	;PUT IT BACK
;
MCHAR2:	MOV	A,D	;RESTORE MODEM STATUS
	ANI	MODOVRE	;OVERRUN?
	CPI	MODOVRE
	JNZ	MCHAR3	;NO, CHECK FOR PARITY ERROR
	LDA	ERRCDE
	ORI	MODOVRE	;TURN ON RECV ERR CODE
	STA	ERRCDE
;
MCHAR3:	MOV	A,D	;RESTORE MODEM STATUS
	ANI	MODPARE	;PARITY ERROR?
	CPI	MODPARE
	JNZ	MCHAR4	;NO, GET DATA CHAR
	LDA	ERRCDE
	ORI	MODPARE
	STA	ERRCDE
;
MCHAR4:
	ENDIF		;PMMI OR H8 OR DCH
;
;Get data char
;
	IN	MODDATP ;READ THE CHAR
	POP	D	;RESTORE DE
;
;Calc checksum and CRC
;
	PUSH	PSW	;SAVE THE CHAR
	CALL	UPDCRC	;CALC CRC
	ADD	C	;ADD TO CHECKSUM
	MOV	C,A	;SAVE CHECKSUM
	POP	PSW	;RESTORE CHAR
	ORA	A	;CARRY OFF: NO ERROR
	RET		;FROM "RECV"
;
;CARCK - common 15 second carrier test for RECV and
;SEND. If carrier returns within 15 seconds, normal
;program execution continues. Else, it will abort
;to CP/M via EXIT.
;
CARCK	MVI	E,150	;VALUE FOR 15 SECOND DELAY
;
CARCK1	CALL	DELAY	;KILL .1 SECONDS
;
	IF	EXTMOD OR H8 OR DCH
	IN	MODCTL2	;READ MODEM STATUS
	ENDIF
;
	IF	PMMI
	IN	BAUDRP	;READ MODEM STATUS
	ENDIF
;
	IF	PMMI AND FRNTPNL
	OUT	PANEL	;DISPLAY STATUS
	ENDIF
;
	ANI	MODDCDB	;CARRIER DETECT MASK
	CPI	MODDCDA	;IS IT STILL ON?
	RZ		;RETURN IF CARRIER ON
	DCR	E	;HAS 15 SECONDS EXPIRED?
	JNZ	CARCK1	;IF NOT, CONTINUE TESTING
	JMP	EXIT	;ELSE, ABORT TO CP/M.
;
;DELAY - 100 millisecond delay.
;
DELAY	PUSH	B	;SAVE B,C
;
	IF	FASTCLK	;IF 4MHZ CLOCK
	LXI	B,16667	;VALUE FOR 100MS DELAY
	ENDIF
;
	IF	NOT FASTCLK
	LXI	B,8334	;VALUE FOR 100MS DELAY
	ENDIF
;
DELAY2	DCX	B	;UPDATE COUNT
	MOV	A,B	;GET MS BYTE
	ORA	C	;COUNT = ZERO?
	JNZ	DELAY2	;IF NOT, CONTINUE
	POP	B	;RESTORE B,C
	RET		;RETURN TO CARCK1.
;
;---->	SEND: Send a character to the modem
;
SEND	PUSH	PSW	;SAVE THE CHARACTER
	CALL	UPDCRC	;calc the crc
	ADD	C	;CALC CKSUM
	MOV	C,A	;SAVE CKSUM
;
	IF	NOT DCH
SENDW	IN	MODCTLP ;GET STATUS
	ENDIF
;
	IF	DCH
SENDW	IN	MODCTL2 ;GET STATUS
	ENDIF
;
	IF	PMMI AND FRNTPNL
	OUT	PANEL	;DISPLAY STATUS
	ENDIF
;
	ANI	MODSNDB ;ISOLATE READY BIT
	CPI	MODSNDR ;READY?
	JZ	SENDR	;..YES, GO SEND
;
;Xmit status not ready, so test for carrier before
;looping - if lost, go to CARCK and give it up to 15
;seconds to return. If it doesn't return abort via
;EXIT.
;
	PUSH	D	;Save D,E
;
	IF	EXTMOD OR H8 OR DCH
	IN	MODCTL2	;READ MODEM STATUS
	ENDIF
;
	IF	PMMI
	IN	BAUDRP	;READ MODEM STATUS
	ENDIF
;
	IF	PMMI AND FRNTPNL
	OUT	PANEL	;DISPLAY STATUS
	ENDIF
;
	ANI	MODDCDB	;CARRIER DETECT MASK
	CPI	MODDCDA	;IS IT STILL ON?
	CNZ	CARCK	;IF NOT, CONTINUE TESTING IT
	POP	D	;RESTORE D,E
	JMP	SENDW	;ELSE, WAIT FOR XMIT READY.
;
;Xmit status ready, carrier still on - send the data.
;
SENDR	POP	PSW	;GET CHAR
	OUT	MODDATP ;OUTPUT IT
	RET		;FROM "SEND"
;
;---->	WAITNAK: Waits for initial NAK
;
;To ensure no data is sent until the receiving
;program is ready, this routine waits for the
;first timeout-NAK or the letter 'C' for CRC
;from the receiver.  If CRC is in effect, then
;Cyclic Redundancy Checks are used instead of
;checksums.
;(E) contains the # of seconds to wait.
;
; If the first character received is a CAN (control-X)
; then the send will be aborted as though it had timed out.
; 04/01/82 BHK 
;
WAITNAK MVI	B,1	;TIMEOUT DELAY
	CALL	RECV	;DID WE GET..
	CPI	NAK	;..A NAK?
	RZ		;YES, SEND BLOCK
	CPI	CRC	;CRC INDICATED?
	JZ	WAITCRC	;YES, GO PUT CRC IN EFFECT
	CPI	CAN	;WAS IT A CANCEL (CONTROL-X)?		; v48c bhk
	JZ	ABORT	;YES, ABORT				; v48c bhk
	DCR	E	;80 TRIES?
	JZ	ABORT	;YES, ABORT
	JMP	WAITNAK ;NO, LOOP
;
;----> WAITCRC: Turn on CRC Flag
;
WAITCRC	XRA	A	;ZERO ACCUM
	STA	CRCFLG	;TURN ON CRC OPT
	RET
;
;---->	MOVEFCB: Moves FCB(2) to FCB
;
;In order to make the XMODEM command 'natural',
;i.e. XMODEM SEND FILENAME (MODEM S FN.FT) rather
;than XMODEM FILENAME SEND (MODEM FN.FT S), this
;routine moves the filename from the second FCB
;to the first.
;
MOVEFCB LXI	H,FCB+16 ;FROM
	LXI	D,FCB	;TO
	MVI	B,16	;LEN
	CALL	MOVE	;DO THE MOVE
	XRA	A	;GET 0
	STA	FCBSNO	;ZERO SECTOR #
	STA	FCBEXT	;..AND EXTENT
	RET
;
CTYPE	PUSH	B	;SAVE..
	PUSH	D	;..ALL..
	PUSH	H	;..REGS
	MOV	E,A	;CHAR TO E
	MVI	C,WRCON ;GET BDOS FNC
	CALL	BDOS	;PRIN THE CHR
	POP	H	;RESTORE..
	POP	D	;..ALL..
	POP	B	;..REGS
	RET		;FROM "CTYPE"
;
HEXO	PUSH	PSW	;SAVE FOR RIGHT DIGIT
	RAR		;RIGHT..
	RAR		;..JUSTIFY..
	RAR		;..LEFT..
	RAR		;..DIGIT..
	CALL	NIBBL	;PRINT LEFT DIGIT
	POP	PSW	;RESTORE RIGHT
;
NIBBL	ANI	0FH	;ISOLATE DIGIT
	CPI	10	;IS IT <10?
	JC	ISNUM	;YES, NOT ALPHA
	ADI	7	;ADD ALPHA BIAS
;
ISNUM	ADI	'0'	;MAKE PRINTABLE
	JMP	CTYPE	;..THEN TYPE IT
;
;---->	ILPRT: Inline print of message
;
;The call to ILPRT is followed by a message,
;binary 0 as the end.
;
ILPRT	XTHL		;SAVE HL, GET HL=MSG
;
ILPLP	MOV	A,M	;GET CHAR
	ORA	A	;END OF MSG?
	JZ	ILPRET	;..YES, RETURN
	CALL	CTYPE	;TYPE THE MSG
	INX	H	;TO NEXT CHAR
	JMP	ILPLP	;LOOP
;
ILPRET	XTHL		;RESTORE HL
	RET		;PAST MSG
;
EXITLG				; SPECIAL LOG CALLER EXIT
	IF	LOGCAL
	JMP	LOGCALL
	ENDIF
	JMP	EXIT
;
;---->	ERXIT: Exit printing message following call
;
ERXIT	POP	D	;GET MESSAGE
	MVI	C,PRINT ;GET BDOS FNC
	CALL	BDOS	;PRINT MESSAGE
;
EXIT	LHLD	STACK	;GET ORIGINAL STACK
	SPHL		;RESTORE IT
;
	IF VOUT			;
	PUSH	PSW		;
	MVI	A,0FFH		;FORCE ECHO-ON.
	STA	ECHOFLG		;
	POP	PSW		;
	ENDIF	;VOUT
;
	if	setarea
	call	restu		; restore old area user & drive ..a 01/06/81
	endif
;
	RET		;--EXIT-- TO CP/M
;
	if	setarea
;
;------> RESTORE THE OLD USER AREA AND DRIVE FROM A RECEIVED FILE
;
RESTU	lda	olddrv		;RESTORE THE OLD DRIVE		;a 01/06/81
	mov	e,a						;a 01/06/81
	call	recdrx						;a 01/06/81
	lda	olduser		;RESTORE THE OLD USER NUMBER	;a 01/06/81
	mov	e,a						;a 01/06/81
	jmp	recare						;a 01/06/91
;
;--------> SET USER AREA TO RECEIVE FILE
RECAREA	call	recdrv		;ok set the drive to its place	;a 01/06/81
	mvi	e,recu		;ok now set the user area	;a 01/06/81
RECARE	mvi	c,user		;tell bdos what we want to do	;a 01/06/81
	call	bdos		;do it				;a 01/06/81
	RET
;
RECDRV	mvi	e,defdrv-41h	;make drive cp/m number		;a 01/06/81
RECDRX	mvi	c,seldrv	;tell bdos			;a 01/06/81
	call	bdos		;do it				;a 01/06/81
	ret			;back				;a 01/06/81
	endif
;
;Move 128 characters
;
MOVE128 MVI	B,128	;SET MOVE COUNT
;
;Move from (HL) to (DE) length in (B)
;
MOVE	MOV	A,M	;GET A CHAR
	STAX	D	;STORE IT
	INX	H	;TO NEXT "FROM"
	INX	D	;TO NEXT "TO"
	DCR	B	;MORE?
	JNZ	MOVE	;..YES, LOOP
	RET		;..NO, RETURN
;
;************************************************************************
;* 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)		*
;*									*
;*									*
;*	There are four entry points, which are used as follows:		*
;*									*
;*	CLRCRC - A call to this entry resets the CRC accumulator.	*
;*		 It must be called at the start of each message.	*
;*									*
;*		 Entry Parameters: None.				*
;*									*
;*		 Exit Conditions:  CRC accumulator cleared.		*
;*				   All registers preserved.		*
;*									*
;*									*
;*	UPDCRC - A call to this entry updates the CRC accumulator.	*
;*		 It must be called once for each byte in the		*
;*		 message for which the CRC is being calculated.		*
;*									*
;*		 Entry Parameters: (A) = a byte to be included		*
;*					 in the CRC calculation.	*
;*									*
;*		 Exit Conditions:  CRC accumulator updated.		*
;*				   All registers preserved.		*
;*									*
;*									*
;*	FINCRC - A call to this entry finishes the CRC calculation	*
;*		 for a message which is to be TRANSMITTED. It must	*
;*		 be called after the last byte of the message has	*
;*		 been passed thru UPDCRC. It returns the calculated	*
;*		 CRC bytes, which must be transmitted as the final	*
;*		 two bytes of the message (first D, then E).		*
;*									*
;*		 Entry Parameters: None.				*
;*									*
;*		 Exit Conditions:  (DE) = calculated CRC bytes.		*
;*				   All other registers preserved.	*
;*									*
;*									*
;*	CHKCRC - A call to this routine checks the CRC bytes of		*
;*		 a RECEIVED message and returns a code to indicate	*
;*		 whether the message was received correctly. It must	*
;*		 be called after the message AND the two CRC bytes	*
;*		 have been received AND passed thru UPDCRC.		*
;*									*
;*		 Entry Parameters: None.				*
;*									*
;*		 Exit Conditions:  (A) =  0 if message ok.		*
;*				   (A) = -1 if message garbled.		*
;*				   All other registers preserved.	*
;*									*
;************************************************************************
;*									*
;*	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
;
;
;
;Temporary storage area
;
MAXEXT	DB	0	;HIGHEST EXTENT NO. SEEN IN FILE SIZE CALC.
RCNT	DW	0	;RECORD COUNT
RCVSNO	DB	0	;SECT # RECEIVED
SECTNO	DB	0	;CURRENT SECTOR NUMBER 
SECCNT	DW	0	;TOTAL SECTOR COUNT
ERRCT	DB	0	;ERROR COUNT
olduser db	0	;save the org user number
olddrv	db	0	;save the org drive number
;
	IF	PMMI OR H8 OR DCH
ERRCDE	DB	0	;RECEIVE ERROR CODE
	ENDIF
;
CRCFLG	DB	'C'	;SET TO NULL IF CRC USED
FIRSTIME DB	1	;TURNED OFF AFTER FIRST SOH RECEIVED
;
;Following 3 used by disk buffering routines
EOFLG	DB	0	;EOF FLAG (1=TRUE)
SECPTR	DW	DBUF
SECINBF DB	0	;# OF SECTORS IN BUFFER
	DS	60	;STACK AREA
STACK	DS	2	;STACK POINTER
;
;16 sector disk buffer
;
DBUF	EQU	$	;16 SECTOR DISK BUFFER
;
;BDOS equates
;
RDCON	EQU	1
WRCON	EQU	2
PRINT	EQU	9
CONST	EQU	11	;CONSOLE STAT
SELDRV	EQU	14	;SELECT DRIVE
OPEN	EQU	15	;0FFH = NOT FOUND
CLOSE	EQU	16	;	"       "
SRCHF	EQU	17	;	"       "
SRCHN	EQU	18	;	"       "
ERASEF	EQU	19	;NO RET CODE
READ	EQU	20	;0=OK, 1=EOF
WRITE	EQU	21	;0=OK, 1=ERR, 2=?, 0FFH=NO DIR SPC
MAKE	EQU	22	;0FFH=BAD
REN	EQU	23	;0FFH=BAD
CURDRV	EQU	25	;GET CURRENT DRIVE
STDMA	EQU	26	;SET DMA
USER	EQU	32	;SET USER AREA TO RECEIVE FILE
BDOS	EQU	BASE+5
FCB	EQU	BASE+5CH ;SYSTEM FCB
FCBEXT	EQU	FCB+12	;FILE EXTENT
FCBSNO	EQU	FCB+32	;SECTOR #
FCB2	EQU	BASE+6CH ;SECOND FCB
;
B1200	EQU	5	;BAUD RATE VALUE FOR 8116 BAUD RATE CHIP
;
	END
