; **** Vestric Link Protocol Handler ****
pif	equ	0
base	equ	6800h
suspend equ	0109h	; Block Voluntarily
listen	equ	012ah	; Z = Modem Character -> A
clock	equ	0133h	; Date & Time -> (DE)
timer	equ	014bh	; Load Slow Timer with DE units
pcheck	equ	01a8h	; Z=Access Code & Password at (HL) correct
launch	equ	2003h	; spawn vdu & reporter
spooler equ	2012h
wait	equ	2015h
putif	equ	2018h	; A -> Modem if DSR is on
dsr	equ	201bh	; terminate if DSR OFF
cut	equ	201eh	; force disconnect
cmsg	equ	5600h	; Customer Message save area (512 bytes)
sec	equ	1200	; Slow Timer frequency 1200Hz
cint	equ	sec/30	; Char interval (sec/bit rate)*10
nul	equ	00h
soh	equ	01h
stx	equ	02h
etx	equ	03h
eot	equ	04h
enq	equ	05h
so	equ	0eh
dle	equ	10h
nak	equ	15h
etb	equ	17h
page	equ	5ch	; Vestric page separator
sep	equ	7eh	; Vestric field separator
time	equ	7fh
s	equ	80h
; Z80 OP Codes--
djnz	equ	00010h
ldir	equ	0b0edh
cpir	equ	0b1edh
; Inter-Task Communication--
ctl	equ	01d0h	; System Control Block
hstate	equ	ctl	; B0: Call connected
			; B1: Order Spooled
			; B3: Rx done
			; B4: Tx done
			; B5: DSR fail
			; B6: Cancelled, incorrectly received
			; B7: Done
rxrecs	equ	ctl+1	; Rx Records Received count
hptr	equ	ctl+4	; -> sub-header
sxrecs	equ	ctl+7	; Tx Records Sent count
area	equ	ctl+8	; -> data storage area
lrecl	equ	ctl+10	; = record length (bytes)
mstate	equ	ctl+12	; B0: Electronic (not Terminal) Mode
			; B1: Passing Rx data to M18
			; B2: Despooling Rx data
			; B3: Spooling Rx data
			; B4: KYBD requests M18 Terminal Mode
			; B5: M18 has refused order
			; B7: Done
txrecs	equ	ctl+13	; Tx Records ready count
name	equ	ctl+19	; -> A/C Name & Address or Reason Refused
naks	equ	ctl+26	; Count of records nak'ed
	org	base
	shld	frame !mov a,m !cpi enq !rnz !inx h !mov a,m !ora a !rnz
	mvi	a,9ah !call putif !call odd4 !rnz !cpi enq !rnz
; ************* V1 Protocol Handler *************
	call	rxset !lxi h,cmsg !shld hptr !shld cptr !call v1rx
	call	field !jnz $-3 !lhld rptr !mvi m,eot !lxi h,rxrecs !inr m
	lhld	area !shld rptr !xra a !sta tos
	lxi	h,hstate !dw 0decbh ; SET 3,(HL); Rx done
	lxi	h,try !mvi m,0ffh	; 1st time Tx flag
	lxi	h,mstate !dw 04ecbh ; BIT 1,(HL); processing Rx data
	cz	notos !cnz sx	; Tx
	call	rxbid !call field !mvi a,'Y' !jz cut
	lxi	d,t4 !call match !jnz ditch !call field !jnz $-3
	lxi	h,hstate !dw 0e6cbh ; SET 4,(HL); Tx done
	mvi	b,6 !call seot !mvi a,'Z' !jmp cut ; disintegrate
notos	call	spooler !lxi h,vr2 !call tx !lxi h,sxrecs !inr m !xra a !ret
sx0	call	v1tos !lxi h,sxrecs !inr m
sx	call	suspend !lxi h,txrecs !lda sxrecs !cmp m !jnz sx0
	call	dsr !lda mstate !ora a !jp sx !ani 20h !rz
	lhld	name !call tx !lda rxrecs !sta sxrecs !ret ; order refused
v1tos	ora	a !rz !call bump	; skip Header
	mov	a,m !cpi eot !jz vt1	; Trailer
	lxi	d,16 !dad d !mov a,m !cpi ' ' !rz ; full delivery
	sta	vr3c !inx h !lxi d,vr3b !lxi b,5 !dw ldir ; flag & TOS
	lxi	d,vr3a !lxi b,43 !dw ldir	; Description
	mvi	a,sep !sta vr3a+30	; split line
	lhld	rptr !lxi d,vr3+6 !lxi b,4 !dw ldir ; PIP Code
	inx	d !lxi b,4 !dw ldir
	lxi	d,vr3+20 !lxi b,5 !dw ldir	; Qty
	lxi	h,tos !inr m !lxi h,vr3 !jmp tx
vt1	inx	h !jmp tx
vh0	ora	m !mov m,a !lhld savehl !dw 04bedh,savebc ; move field -> cmsg
	inx	b !dw 05bedh,cptr,ldir,053edh,cptr ; LD DE,() ; LDIR ; LD (),DE
v1rx	call	v1item !xra a !call m0 !cnz m1 !cnz m2 ; process Header fields
	lxi	h,vflag !jz vh0 !xra a !dw 04ecbh ; BIT 1,(HL)
	jz	vh0 !lhld cptr !mvi m,nul	; looks like end of Header
	lhld	area !shld rptr !xchg !lxi h,v1id !lxi b,16 !dw ldir
	call	launch !call bump !jmp v1line+3 ; 1st line is ready
v1line	call	v1item !call m3 !rz !dw 05bedh,rptr ; LD DE,(rptr)
	lxi	h,pad !lxi b,17 !dw ldir ; preset defaults
	lhld	savehl !dw 04bedh,savebc ; LD BC,(savebc)
	mov	a,m !cpi '0' !jc v1line !cpi '9'+1 !jnc v1line ; not numeric
	call	vcode !call vqty
	lxi	h,rxrecs !inr m !call bump !jmp v1line
vcode	mvi	b,0 !lxi d,wsfq-1
vc1	call	puc !jz vc2 !cpi '*' !jz vc2 !inx	d !stax d !inr b !jmp vc1
vc2	mov	a,b !ora a !rz !cpi 9 !jc $+5 !mvi a,8 ; truncate
	push	b !push h !lhld rptr !lxi b,7 !dad b !xchg
	mov	c,a !dw 0b8edh ; LDDR	; move PIP/Product Code
	pop	h !pop b !ret
vqty	mov	a,c !ora a !rz	; defaults
	lxi	d,wsfq !mvi b,0
	mvi	a,' ' !stax d !inx d !stax d !inx d !stax d
vq1	mov	a,m !inx h !cpi '*' !jz vq3
	cpi	'B' !jnz $+6 !sta wsfq !cpi 'C' !jnz $+6 !sta wsfq+1
	cpi	'0' !jc vq2 !cpi '9'+1 !jnc vq2
	inx	d !stax d !inr b
vq2	dcr	c !jnz vq1
vq3	mov	a,b !lhld rptr !lxi b,12 !dad b !xchg
	ora	a !jz vq4 !cpi 6 !jc $+5 !mvi a,5 ; truncate
	push	d !mov c,a !dw 0b8edh ; LDDR	; move Qty
	pop	d
vq4	inx	d !lxi h,wsfq !lxi b,3 !dw ldir ; move Flags
m0	lxi	d,t0 !call match !rnz	; "ORDER SET "
	lxi	d,vr1+10 !mvi b,3 !call mpad !mvi a,1 !ret
m1	lxi	d,t1 !call match !rnz !dad b !lxi d,-10 !dad d ; "ACC "
	push	h !call pcheck !pop h !jnz wp
m1pif	lxi	d,v1id+2 !lxi b,5 !dw ldir
	mvi	a,2 !ret
m2	lxi	d,t2 !call match !rnz	; "REF "
	lxi	d,v1id+7 !mvi b,8 !call mpad !mvi a,4 !ret
m3	lxi	d,t3	; "ORDER END"
match	lhld	savehl !dw 04bedh,savebc ; LD BC,(savebc)
ma1	ldax	d !inx d !ora a !rz !cmp m !inx h !dcx b !rnz !jmp ma1
wp	IF	pif
	lxi	d,5 !dad d !jmp m1pif
	mvi	a,s+'C' !lxi h,msg2 !jmp cut
mpad	call	puc !stax d !inx d !dw djnz+(mpad-$-2)*256
	xra	a !ret	; Z=1
puc	mov	a,c !ora a !mvi a,' ' !rz !dcr c !mov a,m !inx h 
	cpi	'a' !rc !cpi 'z' !jz $+4 !rnc !sui 20h !ret
ditch	mvi	a,s+'B' !lxi h,msg1 !jmp cut
v1item	call	field !rnz !mvi a,'Y' !jmp cut
field	lhld	fptr !dw 04bedh,roc ; LD BC,(roc)
fi0	mov	a,b !ora c !jnz fi1 !call rx !rz !jmp fi0
fi1	push	h !mvi a,sep !dw cpir,043edh,roc ; CPIR ; LD (roc),BC
	shld	fptr !jnz $+4 !dcx h !pop d
	ora	a !dw 052edh ; SBC HL,DE ; leaves length
	jz	field !mov b,h !mov c,l !shld savebc !xchg !shld savehl !ret
rx	lxi	h,try !mvi m,6 !call listen !jz $-3 ; flush buffer
rx0	call	rxe !mvi a,dle !call puto
	lda	ackn !rrc !mvi a,'0' !jnc $+5 !mvi a,'1' !call puto
rx1	call	odd4 !jnz rx5 !cpi enq !jz rx0
	cpi	eot !jz rx6 !cpi stx !jnz rx1
	lxi	h,0 !shld crcws !lhld frame !lxi b,-2
rx2	call	oddi !jnz rx3 !mov m,a !call crc !inx h !inx b
	mov	a,b !cpi 2 !jnz rx2 !mvi a,'7' !jmp cut ; > 512 chars
rx3	xchg	!lhld crcws !mov a,h !ani s !ora l !jnz rx4
	xchg	!dcx h !dcx h !mov a,m !mvi m,nul
	cpi	etx !jz $+5 !cpi etb !jnz rx4 !sta tail
	lxi	h,ackn !inr m !lhld frame !ora a !ret ; Z=0, C=0
rx4	call	err !call rxe !mvi a,nak !call puto !jmp rx1 ; garbled data
rx5	call	rxe !jmp rx1	; no data
rx6	lda	tail !xri etx !jnz rx0 !ret	; Z=1, C=0
rxe	lxi	h,try !dcr m !rp !mvi a,'6' !jmp cut ; retry count expired
txbid	xra	a !sta ackn !mvi a,etb !sta tail
	call	listen !jz $-3 !lxi h,trye !mvi m,8
tb0	lxi	h,trye !dcr m !mvi a,'5' !jm cut !mvi a,enq !call puto
	lxi	d,2*sec !call timer !call oddw !jnz tb0 !cpi dle !jnz $-8
	call	oddi !jnz tb0 !lxi h,ackn !dw 046cbh ; BIT 0,(HL)
	mvi	e,'0' !jz $+5 !mvi e,'1' !cmp e !cnz flush !jnz tb0
	inr	m !lxi d,vr1a !call clock
	lhld	savehl !push h !lxi h,vr1 !call tx !pop h
tx	shld	savehl !lxi h,try !inr m !mvi m,6 !jz txbid
tx0	lxi	h,try !dcr m !mvi a,'4' !jm cut ; retry count expired
	lxi	h,0 !shld crcws !mvi a,stx !call puto !lhld savehl
tx1	mov	a,m !inx h !ora a !jz tx2 !call putc !jmp tx1
tx2	mvi	a,sep !call putc !lda tail !call putc !lda crcws !call puto
	call	listen !jz $-3 !lxi h,trye !mvi m,6 !jmp ry1
ry0	call	rye !mvi a,enq !call puto
ry1	lxi	d,3*sec !call timer
ry2	call	oddw !jnz ry0 !cpi nak !jz ry4 !cpi dle !jnz ry2
	call	oddi !jnz ry0 !lxi h,ackn !dw 046cbh ; BIT 0,(HL)
	lxi	d,'01' !jz $+6 !lxi d,'10'!cmp e !jnz ry3 !inr m !ret
ry3	cmp	d !cnz flush !jnz ry0
ry4	call	err !jmp tx0
rye	lxi	h,trye !dcr m !rp !mvi a,'5' !jmp cut ; retry count expired
rxbid	lda	rxrecs !sui 2 !lxi d,vr0 !call ba3 ; Lines Taken
	lxi	h,vr0 !mvi a,etx !sta tail !call tx
	lxi	h,try !mvi m,3 !lxi h,hstate !dw 0e6cbh ; SET 4,(HL)
rb0	lxi	h,try !dcr m !mvi a,'8' !jm cut
	mvi	a,eot !call puto !lxi d,3*sec !call timer
	call	oddw !jnz rb0 !cpi enq !jnz $-8
rxset	xra	a !sta ackn !sta tail !sta vflag !lxi h,0 !shld roc !ret
seot	mvi	a,eot !call puto !lxi d,sec/2 !call timer
	call	wait !jz $-3 !dw djnz+(seot-$-2)*256
crc	push	psw !push h !mov e,a
	lhld	crcws !ora h !mov h,a !mov a,e !xra l !mov l,a
	shld	crcws !pop h !pop psw !ret
err	lhld	naks !inx h !shld naks !ret
odd4	lxi	d,4*sec !jmp oddi+3
oddi	lxi	d,cint*4 !call timer
oddw	call	wait !rnz
	ora	a !jpo $+8 !ori s !jmp $+5 !ani 7fh !cmp a !ret ; Z=1
flush	call	oddi !rnz !jmp flush
putc	call	crc
puto	ora	a !jpo $+5 !ori s !jmp putif	; ensure odd parity
bump	lhld	lrecl !xchg !lhld rptr !dad d !shld rptr !ret
; A -> (DE) 3 ASCII chars--
ba3	push	h !mvi h,' ' !lxi b,100 !call digit !lxi b,10 !call digit
	ori	'0' !stax d !inx d !pop h !ret
; Divide A by 10, convert to ASCII--
digit	inr	b !sub c !jnc digit !add c !mov l,a ; save remainder
	mov	a,h !dcr b !jz di1 !mvi h,'0' !mov a,b !ori '0'
di1	stax	d !inx d !mov a,l !ret	; remainder -> A
t0	db	'ORDER SET ',nul
t1	db	'ACC ',nul
t2	db	'REF ',nul
t3	db	'ORDER END',nul
t4	db	'OK',nul
v1id	db	'V2 0000        ',nul
pad	db	'0000000000001   ',nul
msg1	db	s+2,'****** ',time,so,' Strange frame received:-',nul
msg2	db	s+2,so,'*** Wrong password:',nul
null	db	nul
vr0	db	'nnn LINES TAKEN ',sep,'REPLY END',nul
vr1	db	'REPLY SET xxx ',sep,'Sent '
vr1a	db	'ddd dd mmm yy hh:mm:ss',nul
vr2	db	'Stock not checked',nul
vr3	db	page,'ORD  pppp-pppp Qty nnnnn',sep
vr3a	db	'd123456789d123456789d123456789',sep,'packsize pre',sep
	db	'Regret '
vr3b	db	'nnnnn Out-of-Stock ('
vr3c	db	'f)',nul
frame	ds	2	; -> input buffer (1K)
rptr	ds	2	; -> current record in data area
cptr	ds	2	; -> next position in cmsg area
crcws	ds	2
tos	ds	1	; Count of TOS lines
ackn	ds	1	; Current Ack
tail	ds	1	; most recent etb/etx
try	ds	1	; error retry counter
trye	ds	1	; enq retry counter
vflag	ds	1	; V1 Header field flags
fptr	ds	2	; field pointer
roc	ds	2	; remains of count, current frame
savehl	ds	2
savebc	ds	2
wsfq	ds	16	; w/s for flags & qty
	end	base

The QX10 Archive