page	64
	title	'Simple terminal emulator - XMODEM part'
	maclib	term

; -->> File :	XMODEM.ASM
;		==========
; (Adapted from MDM705 from the SIG/M P.D. TOOL)

; Copyright (c)	Werner Cirsovius
;		Hohe Weide 44
;		D-2000 Hamburg 20
;		Federal Republic of Germany
;		Tel.: 040/4223247

;		Version 1.0, January 1988

; ===== Externals =====

; From LIB BASELIB

	extrn	strbi0,crlf,dskwrt,dskred,break,conino,close
	extrn	condir,negde,shfrhl,indexa,multip,fidrus

; From main module TERMINAL

	extrn	errcnt,block,xmitch,errstk,errdo,rcvok,inrdy
	extrn	rcvchr,sndrem,getbd,prbaud

; To TERMINAL

	public	send,receiv

; To module KERMIT

	public	decout

; ***** PART 1 : the SENDER *****

send:
	call	sndtim	;Tell a bit statistic
	mvi	a,true
	sta	firstme	;Init first time
	mvi	e,100
	call	waitnak
sendlp:
	call	ckabort	;Want to terminate while sending file?
	lxi	d,fcb
	call	dskred
	jc	sendeof
	call	incrrn
	mvi	a,0
	sta	errcnt
sendrpt:
	call	ckabort	;Want to terminate while sending file?
	call	sendhdr
	call	sendrec
	lda	crcmod
	cpi	true
	cz	sendcrc
	cnz	sendcks
	call	getack
	jc	sendrpt
	jmp	sendlp
sendeof:
	mvi	a,eot
	call	xmitch
	call	getack
	jc	sendeof
	ret

; ***** PART 2 : the RECEIVER *****

receiv:
	mvi	a,true	;Set mode
	sta	crcmod	;Store it
	sta	firstme
	lxi	d,rcvrdy
	call	strbi0
	lxi	d,crcms
	call	strbi0
	mvi	a,crc
	call	sendit	;Now send the 'crc'
rcvlp:
	call	rcvrecd
	jc	rcveot
	lxi	d,fcb
	call	dskwrt
	jc	rcvfer	;Test error
	call	incrrn
	call	sendack
	jmp	rcvlp
rcveot:
	call	sendack	;Close remote
	lxi	d,fcb
	call	close	;..and the file
	rnc
rcvfer:
	lxi	d,filful
	call	strbi0
	jmp	@abort

; ***** PART 3 : the SUBROUTINES *****

getack:	; Get the ACKNOWLEDGE
	;
	mvi	b,10	;10-seconds maximum wait time
	call	recvdg
	jc	getatot
	sui	ack
	rz		;All done if 'ack' character received
	push	psw
	call	crlf
	pop	psw
	cpi	nak	;Is it a nak?
	jz	getack1	;Show 'nak' in that case
	call	hexo
	lxi	d,hxhed
	jmp	getack2
getack1:
	lxi	d,nakhed
getack2:
	call	strbi0
	lxi	d,ackhd
	call	strbi0	;Print the error message
	call	showerr	;Show the error number
ackerr:
	lda	errcnt	;Increment the error count
	inr	a
	sta	errcnt
	cpi	maxerr	;See if at the limit of 10 errors yet	
	mvi	a,0
	rc		;If not, return
	mvi	a,1
	ret
	;
waitnak:; Wait for NAK
	;
	push	d
	lxi	d,awtcrc
	call	strbi0
	pop	d
waitnlp:
	call	ckabort
	mvi	b,1
	call	recv
	cpi	can	;Want to quit?
	jz	@abort
	cpi	crc	;Crc request?
	jz	gotcrc	;Yes, go set crc flag
	cpi	nak
	jz	gotnak
	dcr	e
	jnz	waitnlp
	jmp	@abort
gotcrc:
	mvi	a,true
	lxi	d,crcrqr
	jmp	gotit
gotnak:
	mvi	a,false
	lxi	d,cksrqr
gotit:
	sta	crcmod	;Make sure mode 'CRC' or Checksum
	call	strbi0	;..tell it
	ret
	;
sendack:; Send ACKnowledge
	;
	mvi	a,ack
	call	xmitch
	ret
	;
sendhdr:; Send header to remote
	;
	lxi	d,sndmes
  	call	strbi0
	push	h	;Store current address
	lhld	block	;Get record number
	call	decout	;Print it in decimal
	pop	h	;Restore current address
	mvi	a,soh	;Send 'soh' character to the output
	call	xmitch
	lda	block	;Send record number to the output
	call	xmitch
	lda	block	;Complement the record number
	cma		;Send this value to the output
	jmp	xmitch
	;
sendit:	; Send character in accu to modem
	;
	push	psw
	call	updcrc	;Update CRC
	add	c	;Fix checksum
	mov	c,a
	pop	psw
	call	xmitch	;Send it
	ret
	;
sendrec:; Send a record to remote host
	;
	mvi	c,0
	call	clrcrc
	lxi	h,dma
sendc:
	mov	a,m
	call	sendit
	inr	l
	jnz	sendc
	ret
	;
rcvrecd:; Receive a package
	;
	mvi	a,0
	sta	errcnt
rcvrpt:
	call	ckabort	;Want to stop receiving file?
	lxi	d,awtms
	call	strbi0
	push	h	;Save it
	lhld	block	;Get record number
	inx	h	;Bump it
	call	decout	;Print record number in decimal
	pop	h	;Restore it
	;
	; If CRC is in effect, there is a 10-second timeout to
	; the first SOH. It then tries several more times to
	; let the sender know the system is capable of re-
	; ceiving a CRC check. At the end of that time a NAK
	; is sent which tells the sender to use CHECKSUM
	; checking instead of CRC. This allows automatic
	; compatability with systems implementing CRC
	;
rcvsq:	; During this time incoming CRC and NAK characters are
	; ignored as these may be the ones we are sending at
	; each timeout, coming back from the full duplex system
	;
	mvi	b,10-1	;10-second wait for 'soh' or 'eot' char.
	call	recv	;..(extra 1 second from rcvserr)
	jc	rcvstot	;Send timeout msg if no char. in 10 sec.
	cpi	soh	;Get a start of header?
	jz	rcvsoh
	ora	a
	jz	rcvsq
	cpi	crc	;Ignore our own 'crc' char. if any
	jz	rcvsq	;Do not count this as a timeout
	cpi	nak	;Ignore our own 'nak' char. if any
	jz	rcvsq	;Do not count this as a timeout
	cpi	eot
	stc
	rz
	call	crlf
	call	hexo
	lxi	d,sohmes
	call	strbi0
rcvprn:
	call	showerr	;Display error count
rcvserr:
	mvi	b,1	;1 second wait after any char. is sent..
	call	recv	;..to insure sender is waiting to copy
	jnc	rcvserr ;If still sending, ignore all chars.
	call	ckabort	;Want to stop receiving now?
	lda	crcmod	;Get 'crc' flag
	cpi	true	;'crc' in effect?
	mvi	a,nak	;Put 'nak' in accum
	jnz	rcvser1	;No, send the 'nak'
	lda	firstme ;Get first time switch
	ora	a	;Has first soh been received?
	mvi	a,nak
	jz	rcvser1	;Yes, then send 'nak'
	mvi	a,crc	;Tell sender 'crc' is in effect
rcvser1:
	call	xmitch	;Send the 'nak' or 'crc' request
	lda	errcnt	;Increment the  error count
	inr	a
	sta	errcnt
	cpi	maxerr	;If 10 already, abort
	jc	rcvrpt	;If less than 10, keep going
	jmp	@abort
	;
rcvstot:; Timeout routine each 10 seconds of no 'SOH'
	;
	lxi	d,timoms
	call	strbi0
	call	showerr	;Display the current error count
	;
	; Routine will switch from CRC to checksum if ERRCNT
	; reaches ERRCRC and currently in CRC mode.
	;
	lda	errcnt	;Get the error count
	cpi	errcrc	;See if less than crc-error try limit
	jc	rcvserr	;If yes, keep trying
	lda	firstme	;Otherwise see if we already got a soh
	ora	a
	jz	rcvserr	;If yes, don't switch to checksum
	lda	crcmod	;If not, see if already in checksum
	cpi	true
	jnz	rcvserr
	mvi	a,false	;Show in checksum now
	sta	crcmod	;Change from crc to checksum
	lxi	d,cktlms
	call	strbi0
	jmp	rcvserr	;Increment error count
	;
showerr:; Get the error count and display on CRT
	;
	push	h	;Save the current address
	lhld	errcnt	;Get the current error number
	inr	l
	mvi	h,0	;Only a 8-bit number, now in 'l' reg.
	call	decout	;Display the error in decimal
	lxi	d,eremes
	call	strbi0
	pop	h	;Restore the current address
	ret
	;
recvdg:	;----> 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.
	;
	call	rcvchr
	call	rcvchr
recv:
	push	d	;Save any current values
	mov	a,b	;Multiply 'b' by 4 for extra delay
	ral
	ral
	mov	b,a
msec:
	call	ckabort	;Want to intentionally abort?
	push	h
	lxi	h,175	;Master delay factor
	call	fixcnt
	xchg		;Save the delay value now in 'hl'
			;Get it back, but in 'de'
	pop	h	;Restore the stack to normal
mwti:
	call	inrdy	;Input have a character ready?
	jc	mchar	;If yes, exit
	dcr	e
	jnz	mwti
	dcr	d
	jnz	mwti
	dcr	b	;Number of seconds wanted
	jnz	msec	;If not zero, do 1-second loop again
	pop	d	;Restore original values
	stc		;No character so set carry bit
	ret
mchar:
	call	rcvchr
	push	psw
	call	updcrc	;Calculate crc
	add	c	
	mov	c,a
	pop	psw
	ora	a
	pop	d	;Restore original values
	ret
	;
getatot:; Indicate timeout error
	;
	lxi	d,timack
	call	strbi0
	jmp	ackerr
	;
rcvsoh:	; Got SOH - get block #, block # complemented
	;
	xra	a	;Zero accum
	sta	firstme ;Indicate first soh recv'd
	mvi	b,1	;1-second delay
	call	recv	;Get record
	jc	rcvstot ;Got timeout
	mov	d,a
	mvi	b,1
	call	recv
	jc	rcvstot
	cma
	cmp	d
	jz	rcvdata
	lxi	d,badsec
	call	strbi0
	jmp	rcvprn
rcvdata:
	mov	a,d
	sta	rcvrno
	mvi	c,0
	call	clrcrc	;Clear crc counter
	lxi	h,dma
@rcvchr:
	mvi	b,1
	call	recv
	jc	rcvstot
	mov	m,a
	inr	l
	jnz	@rcvchr
	lda	crcmod	;In 'crc' mode?
	cpi	true
	jz	rcvcrc	;If yes, exit
	mov	d,c
	mvi	b,1
	call	recv
	jc	rcvstot
	cmp	d
	jnz	rcvcerr
chksnum:
	lda	rcvrno
	mov	b,a
	lda	block
	cmp	b
	jz	recvack
	inr	a
	cmp	b
	rz
	jmp	@abort
rcvcrc:
	mvi	e,2	;Number of crc bytes
rcvcrc1:
	mvi	b,1
	call	recv
	jc	rcvstot
	dcr	e
	jnz	rcvcrc1
	call	chkcrc	;Check 'crc' bytes of received message
	ora	a
	jz	chksnum	;If ok, exit
	lxi	d,crcerr
	call	strbi0	;If not, show error message
	jmp	rcvprn	;Show error number
rcvcerr:
	lxi	d,chkser
	call	strbi0	;If not, show error message
	jmp	rcvprn	;Show error number
recvack:
	call	sendack
	jmp	rcvrecd
	;
ckabort:; Check abort by pressing Ctrl-X
	;
	call	break	;Check any key
	rnc
	call	conino	;Get it
	cpi	can	;Check abort
	rnz
@abort:
	mvi	b,1
	call	recv	;Clear input
	jnc	@abort
	mvi	a,can
	call	xmitch	;Indicate it
abort1:
	mvi	b,1
	call	recv	;..wait a bit
	jnc	abort1
	lxi	d,fcb
	call	close	;Close file
	mvi	a,false
	sta	rcvok	;Set no success
	lhld	errstk	; Then BREAK
	sphl
	lhld	errdo
	pchl		; .. exit anywhere
	;
fixcnt:	; Delay as set by clock
	;
	mvi	a,quarz	;Get the user's clock speed
	push	d
	push	h
	pop	d
cntmul:
	dad	d
	dcr	a
	jnz	cntmul
	pop	d	;Return with answer in 'hl'
	ret
	;
decout:	; Print decimal value in HL
	;
	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	condir
	pop	h
	pop	d
	pop	b
	pop	psw
	ret
	;
hexo:	; Output 8 bit value from accu as hex
	;
	push	psw
	rar
	rar
	rar
	rar
	call	nibbl
	pop	psw
nibbl:
	ani	0fh
	cpi	10
	jc	isnum
	adi	7
isnum:
	adi	'0'		;Add in ascii bias
	jmp	condir
	;
incrrn:	; Increment record count
	;
	push	h
	lhld	block
	inx	h	;Increment
	shld	block
	pop	h
	ret
	;
updcrc:	; Update CRC in accu
	;
	; The generator is X^16 + X^12 + X^5 + 1
	; as recommended by CCITT.
	;
	; An alternate generator which is often used
	; in synchronqous transmission protocols
	; is X^16 + X^15 + X^2 + 1.
	;
	; This may be used by substituting XOR 80h for XOR 10h,
	; and XOR 05h for XOR 21h in the adjacent code.
	;
	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
	xri	10h
	mov	h,a
	mov	a,l
	xri	21h
	mov	l,a
skipit:
	dcr	b
	jnz	updloop
	shld	crcval
	pop	h
	pop	b
	pop	psw
	ret
	;
chkcrc:	;Check crc bytes of received message
	;
	push	h
	lhld	crcval
	mov	a,h
	ora	l
	pop	h
	rz
	mvi	a,0ffh
	ret
	;
clrcrc:	; Init the CRC
	;
	push	h	;Reset crc value
	lxi	h,0
	shld	crcval
	pop	h
	ret
	;
fincrc:	; Finish CRC calculations, get into DE
	;
	push	psw
	xra	a
	call	updcrc
	call	updcrc
	push	h
	lhld	crcval
	mov	d,h
	mov	e,l
	pop	h
	pop	psw
	ret
	;
sendcrc:; Send CRC to remote
	;
	push	psw
	call	fincrc	;Finish the CRC
	mov	a,d
	call	xmitch	;.. send it
	mov	a,e
	call	xmitch
	pop	psw
	ret
	;
sendcks:; Send CHECKSUM to remote
	;
	mov	a,c	;Get it
	jmp	xmitch	;.. send it
	;
sndtim:	; Shows the time to transfer a file at
	; various BAUD rates (50..19200)
	;
	lxi	d,filop
	call	strbi0	;Print following message
	lxi	d,fcb
	call	fidrus
	lxi	d,filcon
	call	strbi0
	lhld	sndrem	;Get record count.
	call	decout	;Print decimal number of records
	lxi	d,stsbrc
	call	strbi0
	call	getbd	;Get the speed indicator
	dcr	a
	push	psw
	lxi	h,btable;Point to baud factor table
	call	indexa	;Index to proper factor
	lhld	sndrem	;Get # of records
	call	dvhlde	;Divide 'HL' by value in DE
	push	h	;..(records/min)
	mov	l,c
	mov	h,b
	call	decout	;Print the minutes portion
	lxi	d,stmin
	call	strbi0
	pop	h
	pop	psw	;Get index for baud rate
	push	h
	lxi	h,recdbl;Point to divisors for seconds
	call	indexa	;Index into table
	pop	h	;Get remainder
	call	multip	;Multiply the 'HL' x 'DE'
	call	shfrhl
	call	shfrhl
	call	shfrhl
	call	shfrhl	
	mvi	h,0
	call	decout	;Print the seconds portion
	lxi	d,stsec
	call	strbi0
	call	prbaud
	lxi	d,bdmes
	call	strbi0
	ret
	;	
dvhlde:	; Divides 'HL' by value in 'DE',
	; upon exit: 'BC'=quotient,'L'=remainder
	;
	push	d	; Save divisor
	call	negde	; Negate divisor
	lxi	b,0	; Init quotient
divl1:
	dad	d	; Subtract divisor from dividend
	inx	b	; Bump quotient
	jc	divl1	; Loop till sign changes
	dcx	b	; Adjust quotient
	pop	d	; Retrieve divisor
	dad	d	; Adjust remainder
	ret

; ***** PART 4 : the DATA FIELD *****

	dseg
if german
rcvrdy	db	'Datei offen, fertig f}r Empfang',0
crcms	db	cr,lf,'CRC eingeschaltet',cr,lf,0
ackhd	db	' kein ACK empfangen - ',0
awtcrc	db	'Warten auf Anfrage',cr,lf,0
crcrqr	db	'CRC Anfrage empfangen',cr,lf,0
cksrqr	db	'Checksum Anfrage empfangen',cr,lf,0
sndmes	db	cr,'Sendung # ',0
awtms	db	cr,'Warten auf # ',0
sohmes	db	'H empfangen nicht SOH - ',0
cktlms	db	'++ Umschaltung auf CHECKSUM Mode ++',cr,lf,0
timack	db	cr,lf,'TIMEOUT bei ACK',cr,lf,0
badsec	db	cr,lf,'++ Sektor Fehler # im Vorspann',0
crcerr	db	cr,lf,'++ CRC Fehler ',0
chkser	db	cr,lf,'++ CHECKSUM Fehler ++ ',0
filful	db	cr,lf,'Schreibfehler der Empfangsdatei',0
filop	db	'Datei offen: ',0
filcon	db	' enth{lt ',0
	db	']bertragungszeit: ',0
stmin	db	' Minuten, ',0
stsec	db	' Sekunden bei ',0
bdmes	db	' Baud',cr,lf,0
else
rcvrdy	db	'File open, ready to receive',0
crcms	db	cr,lf,'CRC in effect',cr,lf,0
ackhd	db	' received not ACK - ',0
awtcrc	db	'Awaiting request',cr,lf,0
crcrqr	db	'CRC request received',cr,lf,0
cksrqr	db	'Checksum request received',cr,lf,0
sndmes	db	cr,'Sending # ',0
awtms	db	cr,'Awaiting # ',0
sohmes	db	'H received not SOH - ',0
cktlms	db	'++ Switching to CHECKSUM mode ++',cr,lf,0
timack	db	cr,lf,'TIMEOUT on ACK',cr,lf,0
badsec	db	cr,lf,'++ Bad sector # in header',0
crcerr	db	cr,lf,'++ CRC error ',0
chkser	db	cr,lf,'++ CHECKSUM error ++ ',0
filful	db	cr,lf,'Receive file write error',0
filop	db	'File open: ',0
filcon	db	' contains ',0
stsbrc	db	' records',cr,lf
	db	'Send time: ',0
stmin	db	' mins, ',0
stsec	db	' secs at ',0
bdmes	db	' baud',cr,lf,0
endif;german
hxhed	db	'H',0
nakhed	db	'NAK',0
timoms	db	cr,lf,'++ Timeout ',0
eremes	db	' ++',cr,lf,0
	;
	;Records/min for 50-19200 baud
	;
btable	dw	2,4,5,6,7,13,25,48,73,96,145,192,288,384,768
recdbl	dw	384,300,192,170,150,74,38,20,16,11,8,5,4,3,2
crcmod	ds	1
crcval	ds	2
firstme	ds	1
rcvrno	ds	1

; +++++ END OF XMODEM PACKAGE +++++

	end