; **** Alpha0 Protocol Handler ****
ph	equ	0	; Protocol 01 at Philip Harris only
base	equ	6000h
suspend equ	0109h	; Block Voluntarily
timer	equ	014bh	; Load Slow Timer with DE units
pcheck	equ	01a8h	; Z=Access Code & Password at (HL) correct
tick	equ	0e7ffh	; Slow Timer status
wait	equ	2015h
putif	equ	2018h	; A -> Modem if DSR is on
spooler equ	2012h
launch	equ	2003h	; spawn vdu & reporter
dsr	equ	201bh	; terminate if DSR OFF
nul	equ	00h
soh	equ	01h
eot	equ	04h
ack	equ	06h
lf	equ	0ah
cr	equ	0dh
nak	equ	15h
rqt	equ	1ah	; request transmission
us	equ	1fh	; Unit Separator
sec	equ	1200	; Slow Timer frequency 1200Hz
cint	equ	sec/30	; Char interval (sec/baud rate)*10
max	equ	20	; Max TOS lines to be sent to HX20
; Z80 OP Codes--
djnz	equ	00010h
ldir	equ	0b0edh
cpir	equ	0b1edh
; Inter-Task Communication--
label	equ	01c2h	; -> Spool Diskette Label
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
			; B6: Electronic Mode axed
			; 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
	push	h !xchg !lhld area !shld rptr !xchg !lxi b,7 !dw ldir
	push	d !lhld label !lxi b,2ah !dad b !lxi b,8 !dw ldir ; default Ref
	xchg	!mov m,nul !shld hptr !pop d !pop h
	mov	a,m !inx h !cpi '0' !jz he1 !cpi '1' !rnz
	lda	hstate !ori 04h !sta hstate ; B2: Long Fields
he1	mov	a,m !inx h !sta plevel
	IF	ph
	cpi	'1' !jnz he2 !call vet5 !jmp he3 ; Access Code
he2	cpi	'2' !rc !cpi '5' !rnc
	mov	a,m !cpi ' ' !jnz $+5 !mvi m,'0'
	push	d !call pcheck !pop d
he3	rnz	!mov a,m !cpi us !jnz he4 !inx h !lxi b,8 !dw ldir ; Ref
he4	mov	a,m !cpi cr !rnz
	call	go !call launch 	; valid header received
	xra	a !sta qhash !call bump
nline	call	lines !cpi soh !jz cancel	; unexpected Header
	cpi	eot !jnz nline	; Nak
eline	call	trailer !jz e1	; valid trailer
	cpi	soh !jz cancel !jmp eline	; Nak
e1	mov	a,c !ora a !jm cancel !call go ; Ack if no count/hash fail
	lhld	rptr !mvi m,eot !lxi h,rxrecs !inr m
	lxi	h,hstate !dw 0decbh ; SET 3,(HL); Rx End of File
	call	suspend !lxi h,mstate !dw 04ecbh ; BIT 1,(HL)
	jnz	report !call spooler
u1	lxi	h,nrec !call send !cpi nak !jz u1
txdone	lxi	h,sxrecs !inr m !lxi h,hstate !dw 0e6cbh ; SET 4,(HL)
	xra	a !ret	; Z=0
report	lhld	area !shld rptr !xra a !sta sxrecs !sta qhash !sta tlines
w0	call	tos !jz w5	; no TOS to send yet
	lda	plevel !cpi '3' !jnc w6	; no limit
	lda	tlines !cpi max+1 !lxi h,tcfail !jz fail ; too many TOS
w6	lxi	h,trec !call send !jz w1 !cpi rqt !jz report !jmp w6
w1	lxi	h,sxrecs !inr m !jmp w0
w5	call	dsr !lda mstate !ora a !jp w0 !dw 077cbh ; BIT 6,A
	lxi	h,axed !jnz fail
	ani	20h !lhld name !jnz fail	; order refused
; TOS Trailer--
	lxi	d,erec+2 !lda tlines !call ascii3a ; TOS Line count
	lda	qhash  !call ascii3a	; Qty Hash Total
	lhld	rptr !lxi b,9 !dad b !lxi b,16 !dw ldir ; Serial No & Value
w7	lxi	h,erec !call send !jz txdone !cpi rqt !jz report !jmp w7
; Too many TOS lines, Axed, or invalid Access Code--
fail	call	send !cpi nak !jz fail !xra a !ret ; Z=1
cancel	lxi	h,hstate !dw 0f6cbh ; SET 6,(HL)
	xra	a !ret	; Z=1
; Test for TOS line from M18--
o0	lxi	h,sxrecs !inr m
tos	call	suspend !lxi h,txrecs !lda sxrecs !cmp m !rz
	ora	a !jz o0	; skip header
	call	bump !mov a,m !cpi eot !rz	; trailer
	lxi	d,trec+6 !lda hstate !ani 04h !jz $+5 !inx d !inx d
	lxi	b,16 !dad b !mov a,m !stax d !inx d ; Flag
	xchg	!mvi m,nul !xchg	; preset nul
	cpi	' ' !lda plevel !jnz ts2 ; TOS exists
	cpi	'3' !jc o0	; no progress reports
	lxi	h,sxrecs !lda txrecs !dcr a !cmp m !jnz o0 ; later lines
	jmp	ts3	; report latest Line No
ts2	cpi	'4' !jz ts3 !lxi b,6 !dad b !lxi b,44 !dw ldir; Text
ts3	lda	sxrecs !lxi d,trec !call ascii3a; Line Number
	push	d !call qtyb
	lda	sxrecs !mov b,a !lda qhash !add b !add l !sta qhash
	pop	d !call qtya
	lxi	h,tlines !inr m !ret	; Z=0
send	push	h
s1	mov	a,m !cpi nul !jz s2 !call pute !inx h !jmp s1
s2	mvi	a,cr !call pute
	lxi	d,2*sec !call timer !call wait !jz s3 !pop h !jmp send
s3	call	even !cpi ack !jz s4 !lhld naks !inx h !shld naks
s4	pop	h !ret
; Fetch Line records--
lines	lhld	rptr !xchg !call getpc !rnz ; get PIP Code
	call	getqty !rnz !shld qsave ; get Qty
; Process Options & End of Record--
	mvi	b,4 !call next !cpi 'B' !cz flag !cpi 'C' !cz flag
	push	psw !mvi a,' ' !jmp l1+2
l1	stax	d !inx d !dw djnz+(l1-$-2)*256
	pop	psw !cpi cr !rnz !call go
; Discard any duplicate record--
	lhld	rptr !xchg !lhld pptr !mvi b,8
n2	ldax	d !cmp m !jnz n1 !inx d !inx h !dw djnz+(n2-$-2)*256
	jmp	lines	; ignore repeated line
n1	call	bump !lxi h,rxrecs !inr m ; advance record pointer
	lda	qhash !lhld qsave !add l !sta qhash !jmp lines
flag	stax	d !inx d !dcr b !jmp next
trailer lhld	rptr !xchg !mvi c,0
	mvi	b,3 !call getn !rnz	; Line Count
	lda	rxrecs !dcr a !cmp l !jz $+5 !mvi c,80h ; count error
	mvi	b,3 !call getn !rnz	; Qty Hash
	lda	qhash !cmp l !jz $+5 !mvi c,80h ; hash error
	call	next !cpi cr !ret
bump	push	d !lhld lrecl !xchg !lhld rptr !shld pptr
	dad	d !shld rptr !pop d !ret
getpc	lxi	b,0 !lda hstate !ani 04h !jz gp1
	call	next !rnz !stax d !inx d !call x2 ; 1st digit
	call	next !rnz !stax d !inx d !call x1 !jmp gp2 ; 2nd digit
gp1	mvi	a,'0' !stax d !inx d !stax d !inx d
gp2	call	next !rnz !stax d !inx d !call x2 ; 3rd digit
	rlc	!rlc !rlc !add b !mov b,a ; *8
	call	next !rnz !stax d !inx d !call x1 ; 4th digit
	rlc	!mov l,a !rlc !add l !add b !mov b,a ; *6
	call	next !rnz !stax d !inx d !call x2 ; 5th digit
	rlc	!rlc !add b !mov b,a ; *4
	call	next !rnz !stax d !inx d !call x1 ; 6th digit
	mov	l,a !rlc !rlc !add l !add b !mov b,a ; *5
	call	next !rnz !stax d !inx d !call x2 ; 7th digit
	mov	l,a !rlc !add l !add b !mov b,a ; *3
	call	next !stax d !inx d !jnz gp3 !call x1 ; 8th digit
	mov	a,c !sui 10 !jp $-2 !adi 10 !mvi a,0 !ret
gp3	mov	l,a !mov a,b !sui 26 !jp $-2 !adi 26+65 !cmp l !mvi a,0 !ret
vet5	mvi	c,0 !mvi b,3 !jmp v2	; check 5 digits with check digit
v1	call	pickup !rnz !call x2
v2	call	pickup !rnz !call x1 !dw djnz+(v1-$-2)*256
	mov	a,c !sui 10 !jp $-2 !adi 10 !ret
x1	ani	0fh !push psw !add c !mov c,a !pop psw !ret
x2	ani	0fh !push psw !rlc !cpi 10 !jm $+5 !sui 9
	add	c !mov c,a !pop psw !ret
; Next HX20 character -> A & set Z if numeric or space--
next	push	b !push d !push h
w2	lxi	d,sec !call timer !call wait !jz w3 !call nogo !jmp w2
w3	call	even !pop h !pop d !pop b
	cpi	' ' !rz !cpi '0' !rm !cpi '9' !rp
	cmp	a !ret	; Z=1
; Input Numeric field & convert to binary--
getqty	mvi	b,5 !lda hstate !ani 04h !jnz getn
	mvi	a,'0' !stax d !inx d !stax d !inx d
	mvi	b,3
getn	lxi	h,0	; Initialize Binary
g3	call	next !rnz !stax d !inx d !call x10 !dw djnz+(g3-$-2)*256
	cmp	a !ret	; Z=1
; Convert A to binary, multiply HL by 10 and add A--
x10	push	d !dad h !push h !dad h !dad h !pop d !dad d
	ani	0fh !mvi d,0 !mov e,a !dad d !pop d !ret
; Convert 5 ASCII chars TOS Qty to binary in HL--
qtyb	lhld	rptr !lxi d,17 !dad d !xchg !lxi h,0 !mvi b,5
qb1	ldax	d !inx d !call x10 !dw djnz+(qb1-$-2)*256
qtya	lda	hstate !ani 04h !jz ascii3 ; B2: Long Fields
	lxi	b,10000 !call digit !lxi b,1000 !call digit !jmp ascii3
; A -> (DE) 3 ASCII characters--
ascii3a mov	l,a !mvi h,0
; HL -> (DE) 3 ASCII characters--
ascii3	lxi	b,100 !call digit !lxi b,10 !call digit
	mvi	a,'0' !ora l !stax d !inx d !ret
digit	xra	a	; clear count & carry flag
di1	inr	a !dw 042edh	; SBC HL,BC
	jnc	di1 !dad b !adi '0'-1 !stax d !inx d !ret
; Pickup next char & set Z if numeric or space--
pickup	mov	a,m !inx h
	cpi	' ' !rz !cpi '0' !rm !cpi '9' !rp !cmp a !ret
nogo	push	h !lhld naks !inx h !shld naks !pop h
	lda	rxrecs !ora a !mvi a,nak !jnz $+5 !mvi a,rqt !jmp pute
go	mvi	a,ack	; acknowledge
pute	ora	a !jpe $+5 !ori 80h !jmp putif ; ensure even parity
even	ora	a !jpe $+5 !mvi a,7fh !ani 7fh !ret ; check even parity
tcfail	db	'*** Too many TOS lines',nul
axed	db	'*** Stock check axed',nul
nrec	db	'n/a',nul
erec	db	't',' '+16
	db	'.... .... .... .... ..',nul
trec	ds	54
pptr	ds	2	; -> previous record in data area
rptr	ds	2	; -> current record in data area
tlines	ds	1	; Count of TOS lines
qhash	ds	1	; Quantity Hash Total
qsave	ds	2	; Quantity save area
plevel	ds	1	; Protocol level
ws	equ	$
	end	base

The QX10 Archive