; **** ALPHA II Session Procedure & Protocol ****
base	equ	5c00h
suspend equ	0109h	; Block Voluntarily
pcheck	equ	01a8h	; Z = Access Code & Password at (HL) correct
kbsw	equ	0fe52h	; Keyboard Switch Status
;
launch	equ	02003h
rx	equ	0200ch
tx	equ	0200fh
spooler equ	02012h
dsc	equ	0201bh
cut	equ	0201eh
cmsg	equ	05600h	; Customer Message save area
;
nul	equ	00h
eot	equ	04h
lf	equ	0ah
so	equ	0eh
time	equ	7fh
s	equ	80h
;
; Z80 OP Codes--
djnz	equ	00010h
ldir	equ	0b0edh
;
; Inter-Task Communication--
label	equ	01c2h	; -> spool Diskette Label
ctl	equ	01d0h	; System Control Block
hstate	equ	ctl	; B0: Call connected
			; B1: Order Spooled
			; B2: Long Fields
			; B3: Rx done
			; B4: Tx done
			; B5: DTR dropped
			; B7: Telecomms process terminated
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
tstate	equ	ctl+18	; B6: RVI request
name	equ	ctl+19	; -> A/C Name & Address or Reason Refused
;
	org	base
	lhld	area !shld rptr !xchg !shld item
	mov	a,b !lxi b,15 !cpi '4' !jnz a1; S/w version 2nd byte
	lda	hstate !ori 04h !sta hstate ; B2: Long Fields
	push	h !lxi b,7 !dw ldir
	pop	h !inx h !inx h !mov a,m !ori '0' !mov m,a
	push	d !call pcheck !pop d !jnz cutc !lxi b,8
a1	dw	ldir
	push	d !lxi d,cmsg !xchg !shld hptr !xchg !lxi b,451 !dw ldir
	pop	d !call cref !call launch !call bump !call msg
nblk	call	rx !cc rvi !jz rxdone !push h !dad b !xthl
nline	pop	b !mov d,h !mov e,l !ora a !dw 042edh ; SBC HL,BC
	jnc	nblk !xchg !push b !call unpack !push h
	call	cdgen !call bumpup !pop h !jmp nline
rxdone	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,mstate !dw 04ecbh ; BIT 1,(HL); processing Rx data
	cnz	sx !cz notos !lxi d,erec+2 !lxi b,2 !call move
	lxi	h,erec !call tx !lxi h,hstate !dw 0e6cbh ; SET 4,(HL) ; Tx done
	lda	rxrecs !sta sxrecs !xra a !ret	; Z=0
;
notos	call	spooler !lda mstate !ani 40h !lxi h,nrec !rz
	xra	a !sta tos !lxi h,crec !ret	; cancel TOS Report
;
; Send TOS Report--
sx	xra	a !call send0	; acknowledge Rx promptly
sx0	lxi	h,sxrecs !inr m
sx1	call	suspend !lxi h,txrecs !lda sxrecs !cmp m !jnc sx3
	call	bump !mov a,m !cpi eot !jz sx2 !call send !jmp sx0
sx2	inx	h !lda tos !inr a !sta tos !ret ; HL-> Outcome, Z=0
sx3	call	dsc !lda mstate !ora a !jp sx1
	ani	40h !xri 40h !lhld name !ret	; Z=0 if refused, Z=1 if axed
;
send	lxi	d,16 !dad d !mov a,m !cpi ' ' !jz se1 ; full delivery
	lxi	d,trec !stax d !inx d	; Flag
	lda	sxrecs !stax d !inx d	; Line No
	lda	hstate !ani 04h !jnz $+5 !inx h !inx h ; B2: Long Fields
	inx	h !lxi b,2 !call move	; TOS Qty, text
	lxi	h,tos !inr m !lxi h,trec !jmp tx
se1	lxi	h,sxrecs !lda txrecs !dcr a !cmp m !rnz ; later lines ready
send0	lxi	h,prec+1 !mov m,a !dcx h !lxi b,2 !jmp tx
;
move	mov	a,m !ora a !rz !stax d !inx h !inx d !inx b !jmp move
;
bumpup	lxi	h,rxrecs !inr m
bump	lhld	lrecl !xchg !lhld rptr !dad d !shld rptr !ret
;
cref	mvi	b,8	; insert default C/ref if blank
cr1	dcx	d !ldax d !cpi ' ' !rnz !dw djnz+(cr1-$-2)*256
	lhld	label !lxi b,2ah !dad b !lxi b,8 !dw ldir ; default C/ref
	ret
;
unpack	mov	d,m !inx h !mov e,m !inx h !push d ; Qty
	dw	05bedh,rptr ; LD DE,(rptr)
	call	upip	; unpack PIP/Product Code
	xthl	!push psw !call bd5 !pop b !pop h ; Qty -> 5 ASCII
	mvi	a,'B' !call flag	; Back Order flag
	mvi	a,'C' !call flag	; Case Qty flag
	mvi	a,' '	; spare flag
flag	dw	038cbh ; SRL B
	jc	$+5 !mvi a,' ' !stax d !inx d !ret
;
; Regenerate Check Digit--
cdgen	lhld	rptr !mvi c,0 !dw 038cbh ; SRL B
	jc	mod26
	call	x2 !call x1 !call x1 !call x1
	xra	a !sub c !jp $+8 !adi 10 !jm $-2 !ori '0' !mov m,a !ret
mod26	inx	h !inx h	; skip 2 digits
	call	x0+2 !rlc !rlc !rlc	; 10000x8
	call	x0 !rlc !mov b,a !rlc !add b	;  1000x6
	call	x0 !rlc !rlc	;   100x4
	call	x0 !mov b,a !rlc !rlc !add b	;    10x5
	call	x0 !mov b,a !rlc !add b !add c	;     1x3
	sui	26 !jnc $-2 !adi 'A'+26 !mov m,a !ret
;
x0	add	c !mov c,a !mov a,m !inx h !ani 0fh !ret
x1	mov	a,m !inx h !ani 0fh !add c !mov c,a
x2	mov	a,m !inx h !ani 0fh
	rlc	!cpi 10 !jm $+5 !sui 9 !add c !mov c,a !ret
;
upip	lda	hstate !ani 04h !cnz up2 !jnz up6 ; B2: Long Fields
	call	up1 !call up1	; insert 2 leading zeros
up6	call	up2 !call up2
up2	mov	a,m !rrc !rrc !rrc !rrc !call up1 !mov a,m !inx h
up1	ani	0fh !ori '0' !stax d !inx d !ret
;
; HL -> (DE) 5xASCII--
bd5	lxi	b,10000 !call digit !lxi b,1000 !call digit
	lxi	b,100 !call digit !lxi b,10  !call digit
	mvi	a,'0' !ora l !stax d !inx d !ret
digit	xra	a
di1	inr	a !dw 042edh ; SBC HL,BC
	jnc	di1 !dad b !adi '0'-1 !stax d !inx d !ret
;
cutc	lhld	item !lxi d,cmsg !lxi b,32 !dw ldir ; save Header
	lxi	h,tstate !dw 0f6cbh ; SET 6,(HL) ; request RVI
	call	rx !lxi h,tx0 !cc rvic
	lhld	item !xchg !lxi h,cmsg !lxi b,32 !dw ldir ; restore
	mvi	a,s+'C' !lxi h,ln1 !jmp cut
;
; Send text (HL)...
msgs	lda	sxrecs !inr a !sta sxrecs
	mov	a,m !ora a !rz !inx h !mvi b,0 !mov c,a
	push	h !dad b !xthl !call tx !pop h !jmp msgs
;
msg	lda	kbsw !ani 02h !rz	; [SF3] requests message
	lxi	h,tx1 !mov a,m !ora a !rz	; no RVI text
	lxi	h,tstate !dw 0f6cbh ; SET 6,(HL) ; request RVI
	ret
;
rvi	lxi	h,tx1
rvic	call	msgs
	lhld	area !inx h !mov a,m !cpi '2' !cz rx ; dup. Header
	xra	a !sta sxrecs !jmp rx
;
tx0	db	tx1-$-1,'Your password is wrong!',lf
tx1	db	0	; no message
;
ln1	db	s+2,so,'*** Wrong password:',nul
nrec	db	'Stock not checked',nul
crec	db	'Stock check abandoned',nul
prec	db	'  '	; TOS progress record
rptr	dw	0	; -> current record in buffer area
erec	db	eot
tos	ds	1	; Count+1 of TOS lines (0=not available)
trec	ds	54
item	ds	2	; -> Telecomms Line Buffer
	end	base

The QX10 Archive