; **** EOE - Electronic Order Entry (ALPHA II) ****
base	equ	3800h
new	equ	not 0
suspend equ	0109h	; Block Voluntarily
clock	equ	0133h	; Date & Time -> (DE)
idler	equ	0166h	; Suspend with Escape option
input	equ	016ch	; Mainframe String -> (HL)
echo	equ	0172h	; A -> Mainframe with echo wait
stow	equ	013fh	; Write Spool Control Sector
unspool equ	0145h	; Oldest Spool Sector -> (DE)
spawni	equ	016fh	; Initiate & count Task at (DE)
resetf	equ	017bh	; Reset Disc System
exitm	equ	0181h	; Terminate Mainframe Job
insert	equ	202ah	; Insert Telecomms Session parameters
mkc	equ	0e7fbh	; M18 kicker timeout counter
count	equ	0e7fch	; Seconds counter
;
; Z80 OP Codes--
ldir	equ	0b0edh
djnz	equ	00010h
;
; ASCII codes--
nul	equ	00h
stx	equ	02h
etx	equ	03h
eot	equ	04h
gs	equ	1dh
fs	equ	1ch
so	equ	0eh
;
taskr	equ	03200h	; Reporter Task
taskv	equ	04000h	; VDU Task
;
; 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: Disconnected
			; B6: Cancelled, incorrectly received
			; B7: Done
rxrecs	equ	ctl+1	; Rx Records received count
hptr	equ	ctl+4	; -> sub-header
area	equ	ctl+8	; -> Rx/Tx Records
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
mtimer	equ	ctl+14	; Mainframe Timer (seconds)
tstate	equ	ctl+18	; B0: M18/HX20 Direct Connection
			; B1: Buffer Area in use
name	equ	ctl+19	; -> A/C Name & Address save area
msub	equ	ctl+21	; Mainframe Subtask count
xstate	equ	ctl+23	; B0: Long Fields (Taskm)
;
	org	base
	ori	0afh !lxi h,ws !cz input !mvi m,nul ; get parms if RING
	call	free !lxi d,buffer !call unspool !cnz despool
	lxi	h,ws !mov a,m !ora a !cnz insert; dialup
	mvi	a,2 !sta mkc
idle	call	hunt !lda mkc !ora a !jp idle
	IF	new
	lxi	d,dt+2 !call clock !lxi h,dt !mvi b,24 !call output
	ENDIF
	mvi	a,40 !sta mkc !jmp idle
;
free	lxi	h,tstate !dw 04ecbh ; BIT 1,(HL); wait for buffers
	rz	!call hunt !jmp free
;
hunt	call	idler !lda mstate !ani 88h !rnz ; do not process
	lda	rxrecs !ora a !rz !call job
	mvi	a,2 !sta mkc !ret
;
despool lxi	h,tstate !dw 0cecbh ; SET 1,(HL); seize buffers
	lxi	h,mstate !dw 0d6cbh ; SET 2,(HL); Despooling
	lhld	exitm+1 !shld savex !lxi h,exit !shld exitm+1
	lxi	h,msg1 !shld hptr !lhld area !shld rptr !xchg
	lxi	h,buffer+1 !mov a,m !sta urecs !inx h !lxi b,30 !dw ldir
	xchg	!call ubump !mvi b,6
u10	lhld	rptr !xchg !push b !lxi b,16 !dw ldir
	xchg	!call ubump !pop b !jz u20 !dw djnz+(u10-$-2)*256
	lxi	d,buffer !call unspool	; read next sector
	lxi	d,buffer !mvi b,8 !jmp u10	; onto next buffer
u20	lhld	rptr !mvi m,eot !lxi h,rxrecs !inr m
	lxi	d,taskr !call spawni
	lxi	d,taskv !call spawni
	call	job !call stow !call exit
	lxi	d,buffer !call unspool !jnz despool !jmp stow
;
exit	lhld	savex !shld exitm+1 !lda mstate !ani 1 !lxi h,msub
ex1	call	suspend !cmp m !jnz ex1	; wait for subtasks
	ora	a !cz resetf	; unspool again if axed
	lxi	h,tstate !dw 08ecbh ; RES 1,(HL); release buffers
	xra	a !sta rxrecs !sta txrecs
	lda	mstate !ani 1 !sta mstate !ret
;
ubump	call	bump !lxi h,rxrecs !inr m !lda urecs !dcr a !cmp m !ret
;
; ************	Pass Order to Mainframe--
job	lxi	h,mstate !dw 0cecbh ; SET 1,(HL); M18 activated
	lhld	area !shld rptr !call head	; Header [STX]
	IF	new
	lxi	h,m0 !mvi b,2 !call send	; Protocol Id
	ENDIF
	lhld	rptr !inx h !inx h !mvi b,5 !call sendn ; Access Code
	mvi	b,8 !call sendm	; Customer Reference
	lxi	d,dt+2 !call clock !lxi h,dt+2 !mvi b,22 !call send !call tail
	lhld	name !call input !mvi m,0 !inx h ; Phone No
	xchg	!lhld name !mov a,m !xchg !cpi '*' !jz refuse
	cpi	'#' !lda xstate !dw 087cbh ; RES 0,(HL)
	jnz	$+8 !ori 01h !sta xstate ; Long Fields
	call	input !mvi m,0 !inx h	; Invoice Address
	call	input !mvi m,0 !inx h	; Delivery Address
	lhld	count !shld mtimer	; start timer
; Process lines--
nline	call	bumpup
n10	call	suspend !lda hstate !dw 077cbh ; BIT 6,A
	jnz	cancel !ani 28h !cpi 20h !jz cancel
	lxi	h,txrecs !lda rxrecs !cmp m !jz n10
	lhld	rptr !mov a,m !cpi eot !jz trailer
	lda	xstate !ani 01h !jz short ; old frame layout
	mvi	b,16 !call output !call	input !mvi m,0 !jnz nline
missing mvi	a,'N' !mov m,a !inx h	; Product not on file
	xchg	!lhld rptr !lxi b,8 !dad b !lxi b,5 !dw ldir ; TOS=Qty Ordered
	lxi	h,na !lxi b,44 !dw ldir
	jmp	nline
short	lxi	d,ws !mvi a,'0' !cmp m !inx h !jnz $+4 !cmp m !inx h
	lxi	b,6 !dw ldir	; 6 digit PIP Code
	inx	h !inx h !lxi b,6 !dw ldir ; 3 digit Qty, 3 flags
	jnz	missing !push h !lxi h,ws !mvi b,12 !call output !pop h
	push	h !inx h !inx h !push h !call input !mvi m,0 !pop d
	pop	h !jz missing !ldax d !mov m,a ; shift Flag left 2 bytes
	mvi	a,' ' !inx h !mov m,a !inx h !mov m,a !jmp nline
trailer mvi	a,gs !call echo 	; ask for Serial No
	lhld	mtimer !xchg !lhld count !ora a !dw 052edh ; SBC HL,DE
	shld	mtimer	; Secs to process lines
	lhld	rptr !inx h !call input !mvi m,0; Serial No & Value
	call	bumpup !mvi a,80h
quit	lxi	h,mstate !ora m !mov m,a !ret
cancel	mvi	a,fs !call echo 	; disconnected before Rx done
	lhld	rptr !call input !mvi a,80h !jmp quit ; stock returned
refuse	mvi	a,0a0h !jmp quit	; M18 refused order
;
bumpup	lxi	h,txrecs !inr m
; Advance Record Pointer--
bump	push	d !lhld rptr !xchg !lhld lrecl !dad d !shld rptr !pop d !ret
;
head	mvi	a,stx !jmp echo
output	call	head !call send
tail	mvi	a,etx !jmp echo
;
send	mov	a,m !inx h !call echo !dw djnz+(send-$-2)*256
	ret
sendn	mov	a,m !inx h !cpi ' ' !jnz $+5 !mvi a,'0'
	call	echo !dw djnz+(sendn-$-2)*256
	ret
sendm	push	h !mov l,m !mvi h,0 !lxi d,table-20h !dad d !mov a,m !pop h
	inx	h !call echo !dw djnz+(sendm-$-2)*256
	ret
;
table	db	' ."..%&',27h,'().+,-./'	; Metacode character table
	db	'0123456789......'
	db	'.ABCDEFGHIJKLMNO'
	db	'PQRSTUVWXYZ(/)..'
	db	'.ABCDEFGHIJKLMNO'
	db	'PQRSTUVWXYZ(/)..'
m0	db	'M0'				; Protocol Id
dt	db	'DTddd dd mmm yy hh:mm:ss'
na	db	'Not on File                                ',nul
msg1	db	so,'Despooled',nul
urecs	db	1	; Records unspooled
pointer ds	2	; temporary addr storage
rptr	ds	2	; -> current record in data area
savex	ds	2	; -> original exitm routine
buffer	ds	128	; Spool Buffer
ws	ds	57	; Run Parameters (RING only)
	end	base

The QX10 Archive