; **** Telecomms Controller - MT Modem ****
base	equ	4600h
suspend equ	0109h	; Block Voluntarily
get	equ	0118h	; Com3 -> A
put	equ	011bh	; A -> Com3
listen	equ	012ah	; Z= Com3 -> A
io	equ	0130h	; Screenhandler
timer	equ	014bh	; Load Slow Timer with DE units
open	equ	0157h	; Open Comms Port
close	equ	015ah	; Close Comms Port
trace	equ	017eh	; A -> screen if [SF1] lit
print	equ	0187h	; (HL) -> Printer
count	equ	0e7fch	; Seconds counter
tick	equ	0e7ffh	; Slow Timer Status
kbsw	equ	0fe52h	; Keyboard Switch Status
;
exit	equ	02006h	; Telecomms Exit routine
dsc	equ	0201bh	; Test for disconnection
session equ	02027h	; Telecomms Session Procedure
frame	equ	07800h	; Telecomms Buffer (1K)
;
sec	equ	1200	; Slow Timer frequency 1200Hz
dreg	equ	0c5h	; Comms Data channel
;
nul	equ	00h
bel	equ	07h
lf	equ	0ah
cr	equ	0dh
so	equ	0eh
time	equ	7fh
s	equ	80h
;
; Z80 OP Codes--
djnz	equ	00010h
ldir	equ	0b0edh
cpir	equ	0b1edh
;
; Inter-Task Communication--
config	equ	01ceh	; B7: Autodial Modem
ctl	equ	01d0h	; System Control Block
hstate	equ	ctl	; B0: Call connected
			; B5: DTR dropped
			; B7: Telecomms Process Done
tstate	equ	ctl+18	; B0: M18/HX20 Direct Connection
			; B1: Buffer Area in use
			; B2: Report being printed
			; B4: Tx inhibit
			; B5: System Update enable
			; B6: (Receive State) Request RVI
			; B7: [BREAK] pressed
tsub	equ	ctl+22	; Telecomms Subtask count
naks	equ	ctl+26	; Count of records Nak'd
;
	org	base
	shld	stdby !call load
	lxi	h,txz	 !shld 200ah
	lxi	h,rx	 !shld 200dh
	lxi	h,tx	 !shld 2010h
	lxi	h,wait	 !shld 2016h
	lxi	h,putif  !shld 2019h
	lxi	h,cut	 !shld 201fh
	lxi	h,hunt	 !shld 2022h
	lxi	h,waiti  !shld 2025h
	lxi	h,insert !shld 202bh
	lxi	h,dscf	 !shld dsc+1
	xra	a !sta hstate !sta tsub !dw 073edh,savesp ; LD (savesp),SP
;
go	lxi	h,free !shld exit+1 !lda tstate !ani 8fh !sta tstate
	lxi	h,0 !shld naks !shld trip !mvi a,1 !sta ack
	call	online !rnz !lxi h,parm !call session !mvi a,'Z'
;
cut	dw	07bedh,savesp ; LD SP,(savesp)	; unconditional Disconnect
	push	h !push psw !ani 7fh !sta p1+23 ; completion code
	call	offline !lxi d,p1+36 !call hmmss; duration
	lhld	naks !lxi d,p1+49 !call bindec	; frames repeated
	lhld	trip !lxi d,p1+64 !call bindec	; DCD tripouts
	call	exit !lxi h,hstate !dw 086cbh,0aecbh ; RES 0,(HL) ; RES 5,(HL)
	pop	psw !pop h !ora a !cnz dscmsg !jmp go
;
dscmsg	cm	errmsg !lxi h,p1 !call print !lxi h,foot !jmp print
errmsg	call	print !lxi h,frame !mvi b,1 !mov a,m !ora a !cnz print !ret
;
; Check connection status (Half Duplex & Local)--
dsch	call	break !call dsroff !rz !mvi a,'1' !jmp cut
; Check connection status (Full Duplex)--
dscf	call	cdt !rnz !push h !lhld trip !inx h !shld trip
	call	dcdlim !call timer !pop h
cd1	call	dsroff !mvi a,'1' !jnz cut !call cdt !rnz ; DCD restored
	call	suspend !lda tick !ora a !jz cd1 !mvi a,'2' !jmp cut
;
dcdlim	lxi	h,tstate !dw 046cbh ; BIT 0,(HL); LOGON
	lxi	d,6*sec/10 !rnz !lxi h,hstate !dw 07ecbh ; BIT 7,(HL)
	lxi	d,sec !rnz !lxi d,8*sec !ret
;
cdt	call	break !di !in dreg !ani 8 !push psw ; isolate DCD
	mvi	a,10h !out dreg !pop psw !ei !ret ; unlatch SIO status
break	lda	tstate !ora a !rp !mvi a,'X' !jmp cut ; force abort
;
ol0	call	break !call close !lxi d,sec/2 !call timer ; drop DTR
online	call	nap !lxi h,tstate		; wait as reqd
ol1	call	suspend !dw 04ecbh ; BIT 1,(HL) ; wait for buffers
	jnz	ol1 !dw 0becbh ; RES 7,(HL)	; discard any BREAK
	call	parms !rnz !call modem !jnz ol0 ; no connection
	lxi	h,tstate !dw 04ecbh,0cecbh ; BIT 1,(HL) ; SET 1,(HL)
	jnz	ol0				; seize buffers if still free
	lxi	h,0 !shld count !lxi h,hstate !dw 0c6cbh ; SET 0,(HL)
	lxi	h,next !mov a,m !cpi 'a' !jnc $+5 !mvi m,'0' ; cancel retries
	lda	mode !ori 20h !cpi 'n' !jz ol2	; Null Modem (ignore DSR & DCD)
	lda	chan !cpi 'H' !jnz ol4		; Full Duplex
	lxi	b,502h !call sio !lxi b,320h !call sio ; RTSoff AEon
ol2	lxi	h,dsch				; don't monitor DCD
ol3	shld	dsc+1 !lhld wr5wr3 !xchg !xra a !ret ; Z=1, D=WR3, E=WR5
ol4	lxi	b,-45				; Full Duplex, wait for DCD
ol5	call	suspend !call break !call dsroff !mvi a,'1' !jnz cut ; DSRoff
	lhld	count !dad b !mvi a,'0' !jc cut ; timed out
	mvi	a,10h !out dreg !in dreg !ani 8 !jz ol5 ; DCDoff
	lxi	h,dscf !jmp ol3
;
parms	lda	next !ora a !jz $+6 !sta mode	; update mode if not first time
	lda	mode !cpi '1' !jc pa3 !cpi '9'+1 !jc pa1 ; numeric, non-zero
	cpi	'a' !jnc $+5 !mvi a,'0' !jmp pa2; no repeat unless lower case
pa1	dcr	a				; reduce retry count
pa2	sta	next !xra a !ret		; Z=1
pa3	lhld	stdby !call load		; runout, restore entry parms
	lda	mode !cpi 'a' !rc !xra a !ret	; task done if Z=0
;
offline lxi	h,hstate !dw 0eecbh,046cbh ; SET 5,(HL) ; BIT 0,(HL)
	lhld	count !jnz $+6 !lxi h,0 !push h ; HL=connect duration
	call	close !lxi d,2*sec !call timer	; disconnect 2 secs min
	call	listen !call dsroff !jz $-6 !pop h !ret ; wait for DSRoff
;
modem	call	dsroff !push psw !lxi h,config !dw 0becbh ; RES 7,(HL)
	lxi	h,v23 !call open !dw 053edh,wr5wr3 ; LD (wr5wr3),DE
	call	rate !shld gap !pop psw !rz	; DSR was already ON
	call	snap !call dsroff !lda mode !dw 0efcbh ; SET 5,A (lower case)
	jz	auto !cpi 'n' !rz		; Null Modem
dsr	call	suspend !lda tstate !ani 82h !rnz ; break, or buffers taken
	call	dsroff !rz !jmp dsr		; wait for DSR
;
auto	lxi	h,config !dw 0fecbh ; SET 7,(HL)
	lxi	h,num !cpi 'n' !jz cfig 	; configure modem
	cpi	'w' !call prep !jnz connect	; Z=wait for ring or DATA
	push	h !call cmd !pop h !rnz !mov a,m !cpi 'D' !jnz au1
	lxi	h,beep !call io !lxi d,2*sec !call timer !call nap ; 2 secs
	lxi	h,drop !call cmd !rnz		; drop line
au1	mvi	b,1 !call result !jm au2 !rnz !cpi '2' !rnz ; (no timeout)
au2	lda	tstate !ani 7fh !sta tstate !call ao
connect call	cmd !rnz !cpi '1' !rz !mvi a,'F' !jmp cut
;
prep	push	psw !mov a,m !ora a !jnz pp1 !pop psw !rz !call ao !ori 1 !ret
pp1	lxi	d,dial+1 !mvi b,20 !inx h
pp2	call	vet !call char !jnz pp2 
	push	d !lxi h,p4 !call print 	; log call details
	call	ao !pop h !jnz $+6 !mvi m,'R' !inx h ; reverse mode
	pop	psw !jnz $+6 !mvi m,';' !inx h !mvi m,nul
	lxi	h,dial !mvi m,'D' !ret
;
vet	cpi	'9'+1 !rnc !cpi '0' !jnc $+6 !cpi ',' !rnz
	dcr	b !rm !stax d !inx d !ret
;
char	mov	a,m !ora a !rz !inx h !cpi lf !rz !cpi cr !ret
;
ao	lda	chan !lxi h,cmda !cpi 'A' !rz !cpi 'M' !rz ; answer mode
	lxi	h,cmdo !ret			; originate mode
;
cfig	mov	a,m !ora a !rz !call cmd !rnz !call ctsw !jmp cfig
ctsw	call	cts !rnz !call suspend !jmp ctsw
;
cmd	mvi	a,cr !call put !call snap
	mvi	a,'A' !call put !mvi a,'T'
cm1	call	put !call char !jnz cm1 !call listen !cz flush
	lxi	d,0 !call timer !mvi a,cr !call put !mvi b,0 ; 54 secs timeout
result	mov	c,a !call listen !cnz rt !rnz
	cpi	cr !jnz result !cmp c !cz flush !mov a,c !cmp a !ret
;
rt1	call	cts !jnz rt0 !call snap !call cts !mvi a,'9' !jz cut
rt0	call	listen !rz !dw 040cbh ; BIT 0,B
	jnz	rt !lda tick !ora a !jnz fo1	; timed out
rt	lda	tstate !ani 82h !jz rt1 !dw 040cbh ; BIT 0,B
	jz	fo1 !ora a !ret
fo1	mvi	a,'x' !call put !lxi d,2*sec !call timer ; force off-line
fo2	call	listen !jz fo3 !lda tick !ora a !rnz !jmp fo2
fo3	cpi	cr !jnz fo2 !ori 1 !ret
;
flush	lxi	d,sec/8 !call timer
fl1	call	listen !jz flush !lda tick !ora a !jz fl1 !ret
;
hunt	shld	savehl
ht0	lhld	savehl !dcr m !mvi a,'5' !jm cut
	call	enq !call wait1 !jnz ht0 !lxi b,0
ht1	mov	e,a !ani 7fh !mov m,a !mov a,e !inx h !inx b
	ora	a !mvi a,40h !jpe $+4 !rlc !ora b !mov b,a ; test parity
	ani	4 !mvi a,'7' !jnz cut		; 1024 bytes received
	call	waiti !jz ht1 !mvi m,nul
	mov	d,b !mov a,b !ani 3fh !mov b,a !mov a,d
	lxi	h,frame !ani 0c0h !rpo		; M=odd (not even) parity
	call	eof !lxi h,frame !rz !mvi a,3 !ora a !ret ; Z=detected
;
enq	inx	h !mov a,m !ora a !rz !call putif !jmp enq
;
; Receive Record--
rx	lxi	h,try !mvi m,10 !call listen !jz $-3 ; flush buffer
rx0	call	red !call wait2 !jnz rx0 !call string !jnz rx1 ; CRC fail
	lxi	h,tstate !dw 0a6cbh ; RES 4,(HL) ; Tx enable
	lda	ack !inr a !sta ack !ori 1 !jmp rx2 ; Z=0, C=0
rx1	lda	tstate !ani 10h !jnz rx0	; Rx file is empty, so no EOF
	call	eof !cnz err !jnz rx0 !mov a,m !rlc !rlc ; tstate B6 -> C
rx2	dw	0b6cbh ; RES 6,(HL)
	lxi	h,frame !ret
;
eof	call	nak !lxi d,frame		; HL -> Current NAK
ef1	ldax	d !cmp m !rnz !inx d !inx h !ora a !jnz ef1
	lxi	h,tstate !dw 0e6cbh ; SET 4,(HL); inhibit next Tx
	ret					; Z=1 (EOF)
;
; Transmit (HL) until nul--
txz	push	h !xra a !lxi b,0 !dw cpir	; search for nul
	lxi	h,-1 !dw 042edh ; SBC HL,BC	; length->HL
	mov	b,h !mov c,l !pop h
; Transmit (HL) for BC bytes--
tx	shld	savehl !lxi h,try !mvi m,7 !dw 043edh,savebc ; LD (savebc),BC
tx0	lxi	h,try !dcr m !mvi a,'4' !jm cut
	lxi	h,0 !shld crcws !lhld savehl !dw 04bedh,savebc ; LD BC,(savebc)
tx1	mov	a,b !ora c !jz tx2 !dcx b
	mov	a,m !inx h !call putif !call crc !jmp tx1
tx2	lda	crcws+1 !call putif !lda crcws !call putif
	lxi	h,tryr !mvi m,12 !call listen !jz $-3 ; flush buffer
tx3	lxi	h,tryr !dcr m !mvi a,'3' !jm cut
	call	reply !jnz tx3 !cnc ackt !jnz tx0 !lxi h,ack !inr m ; (C=RVI)
nak	lda	ack !rar !lxi h,even !jc $+6 !lxi h,odd !ral !ret ; HL-> NAK
;
reply	call	wait2 !rnz !call select !rnz	; Z if HL -> possible match
	call	waiti !rnz !inx h !cmp m !jnz ry1 ; no match
	inx	h !mov a,m !inx h !rrc !ret	; C=RVI request received
ry1	call	waiti !rnz !jmp ry1		; flush
;
select	lxi	h,even !cmp m !rz !lxi h,odd !cmp m !rz
	lxi	h,white !cmp m !ret
ackt	lda	ack !xra m !ani 1 !rz !jmp err	; Z=correct ack
;
wait1	lxi	d,sec !jmp $+6
wait2	lxi	d,2*sec !lxi h,0 !shld crcws !lxi h,frame !jmp wait0
waiti	dw	05bedh,gap ; LD DE,(gap)	; frame timeout
wait0	call	timer
wait	call	listen !jz crc !call dsc
	lda	tick !ora a !rnz !jmp wait
;
red	lxi	h,try !dcr m !mvi a,'6' !jm cut
	lda	tstate !ani 40h !lxi h,white !cz nak
	mov	a,m !call putif !inx h !mov a,m !jmp putif
;
crc	push	psw !push b !push h
	lhld	poly !xchg !lhld crcws !mvi b,8
cr1	mov	c,a !ani 80h !xra h !mov h,a !dad h !jnc cr2
	mov	a,e !xra l !mov l,a !mov a,d !xra h !mov h,a
cr2	mov	a,c !ral !dw djnz+(cr1-$-2)*256
	shld	crcws !pop h !pop b !pop psw !ret
;
string	mov	m,a !inx h !lxi b,-2		; initialize byte count
st1	call	waiti !jnz st2 !mov m,a !inx h !inx b
	mov	a,b !cpi 2 !jnz st1 !mvi a,'7' !jmp cut ; string > 512 char
st2	dw	078cbh ; BIT 7,B	; Z=0 if <3 bytes received
	inx	b !cz st3 !jnz $+5 !dcx h !dcx h !mvi m,nul !ret
st3	xchg	!lhld crcws !mov a,h !ora l !xchg !ret ; Z=1 if CRC OK
;
err	lhld	naks !inx h !shld naks !mvi a,bel !jmp trace
;
putif	push	psw !call pu1 !pop psw !jmp put ; A -> Modem if ready
pu1	call	dsc !in dreg !ani 04h !rnz !call suspend !jmp pu1
;
hmmss	lxi	b,3600 !call digi			   ; h
	lxi	b,600 !call digia !lxi b,60 !call digi	   ; :mm
	lxi	b,10 !call digia !mov a,l !ori '0' !stax d ; :ss
	ret
digia	mvi	a,':' !stax d !inx d
; Divide HL by BC, remainder to HL, ASCII result to (DE)--
digi	mvi	a,'0'-1
dg1	inr	a !ora a !dw 042edh ; SBC HL,BC
	jp	dg1 !dad b !stax d !inx d !ret
;
; HL binary -> (DE) ASCIIx4--
bindec	lxi	b,1000 !call digi !lxi b,100 !call digi
	lxi	b,10 !call digi !mov a,l !ori '0' !stax d !ret
;
snap	lxi	d,sec/8 !call timer		; 125msec nap
nap	call	suspend !lda tick !ora a !rnz !jmp nap
dsroff	in	0cch !dw 07fcbh ; BIT 7,A	; Z=DSRon
rtn	ret
cts	mvi	a,10h !out dreg !in dreg !ani 20h !ret ; Z=CTSoff
sio	mov	a,b !lxi h,wr5wr3 !cpi 5 !jz $+4 !inx h ; modify SIO Reg
	di	!out dreg !mov a,m !xra c !out dreg !ei !mov m,a !ret
;
; Set clock speed, HL=frame gap (timer units)--
rate	lxi	h,400 !lda chan !cpi 'M' !rz	; 1200Tx/75Rx
	lxi	h,160 !lxi d,140h !cpi 'O' !jz re1 !cpi 'A' !jz re1 ; 300bps
	lxi	h,40 !cpi 'T' !rz !cpi 'H' !rz !cpi '1' !rz ; 1200or75Tx/1200Rx
	lxi	h,20 !lxi d,28h !cpi '2' !jz re1; 2400bps
	lxi	h,10 !lxi d,14h !cpi '4' !jz re1; 4800bps
	lxi	h,5  !lxi d,0ah 		; 9600bps
re1	mvi	a,036h !out 0cbh !mov a,e !out 0c8h !mov a,d !out 0c8h
	mvi	a,0b6h !out 0cbh !mov a,e !out 0cah !mov a,d !out 0cah !ret
;
insert	xchg	!lxi h,tstate !dw 04ecbh,0cecbh ; BIT 1,(HL) ; SET 1,(HL)
	xchg	!jnz load !call suspend !call load
free	lxi	h,tstate !dw 08ecbh ; RES 1,(HL); release buffers
	ret
load	lxi	d,parm !lxi b,57 !dw ldir	; load session parameters
	xra	a !stax d !sta next !ret
;
hl	pchl
;
v23	db	0ah,0ah,3,0,1,0dfh	; 1200/1200 8 N 1 AEoff RTSon
cmda	db	'A',nul
cmdo	db	'O',nul
drop	db	'H',nul
poly	dw	08005h	; CRC generating Polynomial
even	db	92,61,nul,0
odd	db	99,193,nul,1
white	db	165,102,1
beep	db	0,0,88h,nul
dial	db	'D12345678901234567890R;',nul	; workspace for dial string
p1	db	81h,'****** ',time,'  Disconnect (x), duration h:mm:ss'
	db	', Nak nnnn, DCD trip nnnn',nul
foot	db	84h,nul
null	db	nul
p4	db	82h,'****** ',time,'  Trying '
parm	ds	1	; Session Procedure code
mode	ds	1	; Retry Mode
chan	ds	1	; Physical Channel id
num	ds	55	; phone number & name
next	ds	1	; Mode byte, next try (first time=0)
crcws	ds	2
rptr	ds	2	; -> current record in data area
ack	ds	1	; B0: Current ACK odd/even
try	ds	1	; error retry counter
tryr	ds	1	; reply retry counter
trip	ds	2	; DCD tripout counter
gap	ds	2	; end of received frame timeout
wr5wr3	ds	2
stdby	ds	2
savesp	ds	2
savehl	ds	2
savebc	ds	2
	end	base

The QX10 Archive