; **** MOLECULAR PROGRAM EMULATOR - ALPHA II ****
base	equ	0b800h
suspend equ	0109h	; Block Task Voluntarily
get	equ	011eh	; DRE Character -> A
put	equ	0121h	; A -> DRE
cword	equ	01c0h	; Option byte
;
; Z80 OP Codes--
ldir	equ	0b0edh
djnz	equ	00010h
;
; Significant ASCII characters--
nul	equ	00h
stx	equ	02h
etx	equ	03h
bel	equ	07h
lf	equ	0ah
cr	equ	0dh
so	equ	0eh
si	equ	0fh
syn	equ	16h
can	equ	18h
esc	equ	1bh
fs	equ	1ch
gs	equ	1dh
us	equ	1fh
;
	org	base
	jmp	los
; ************	RING - Electronic Order Entry with dialup
ring	lxi	h,teoe !call osput !lxi h,msg4 !call osget !rz
	call	init !lxi h,parms !call output !jmp header
; ************	EOE  - Electronic Order Entry
eoe	lxi	h,teoe !call osput !call init !jmp header
; Reject Header--
reject	lxi	h,nid !call output
; Input Access Code & Order Number--
header	call	input !rz !jm header
	lda	inbuf !cpi 'D' !jz header	; discard Date/Time frame
	mvi	a,'A' !call faker !jz reject
	lxi	h,id !call output		; A/C & Phone No
	lxi	h,invto !call output		; Invoice Address
	lxi	h,dlyto !call output		; Delivery Address
	xra	a !sta lineno
;
; Input next line--
nline	lxi	h,lineno !inr m !jmp rline
miss	lxi	h,null !call output		; Product not found
rline	call	input !jz quit !jm trail
	mvi	a,'N' !call faker !jz miss
	mvi	a,'T' !call faker !lxi h,tos !jz report
	mvi	a,'B' !call faker !lxi h,tf !jz report
	mvi	a,'H' !call faker !cz halt
	lxi	h,full
report	call	output !jmp nline
;
trail	cpi	gs !jz post
quit	push	psw !lxi h,rting !lda lineno !dcr a !cnz osput !pop psw
	rz	!lxi h,null !call output !jmp header
;
post	lxi	h,trailer !call output !jmp header
;
halt	lxi	h,halted !call osput !mvi a,'H'
h10	call	suspend !call faker !rz !jmp h10
;
faker	push	h !lxi h,cword !cmp m !jnz $+5 !mvi m,0 !pop h !ret
;
teoe	db	cr,cr,'ELECTRONIC ORDER ENTRY simulator  PRINT Q 12',nul
nid	db	'*** INVALID ACCESS CODE!',nul
id	db	'#1PHONE 0602 261959  A/C    1D',nul
parms	db	'SWA261959',cr
invto	db	'J WELLINGTON WELLS',cr,'(DEALER IN MAGIC AND SPELLS)',cr
	db	'THE SPOOKERY',cr,'BATT END',cr,'WYCHAMPTON',nul
dlyto	db	'J WELLINGTON WELLS',cr,'(DEALER IN MAGIC AND SPELLS)',cr
	db	'THE SPOOKERY',cr,'BATT END',cr,'WYCHAMPTON',nul
full	db	'      TENORMIN CALENDAR PACK        '
	db	'    200UN BOX',nul
tf	db	'B    1CICATRIN POWDER               '
	db	'     15G  TAB',nul
tos	db	'T    1CICATRIN POWDER               '
	db	'     15G  TAB',nul
rting	db	cr,so,'RETURNING STOCK',si,nul
halted	db	cr,so,bel,'TASK 000001 HALTED AT 00/1377',si,nul
trailer db	'INVOICE 00000 #99999.99-',nul
lineno	db	0	; Current Line No
;
; **************** FLOP - SDA Floppy Disc Transfer ************
flop	dw	073edh,savesp ; LD (savesp),SP
	lxi	h,tims !call osput !call init !lxi h,hims
	mvi	a,'I' !call faker !jnz $+6 !lxi h,pims
	mvi	a,'P' !call faker !jz pr0
im1	call	output
im2	call	input !rz !jp im2	; ignore data
	cpi	fs !jnz $+6 !lxi h,hims !jmp im1 ; diskette full
;
pr0	xra	a !sta flag !lxi h,prec0 !call output !mvi b,100
pr1	lxi	h,prec1 !call send !dw djnz+(pr1-$-2)*256
pr2	lxi	h,null !call send !mvi a,1 !sta flag !jmp pr2
;
send	push	b !call input !pop b !jm output !jnz send
	dw	07bedh,savesp ; LD SP,(savesp)
	lxi	h,msg3 !lda flag !ora a !cz osput !ret
;
tims	db	cr,cr,'TRANSFER TO DISKETTE',nul
pims	db	'S8884485J Wellington Wells (Dealer in Magic & Spells)',nul
	db	'XTS18046037+ALJG000003+CNDF000003+CJGW000003+CTDH000001'
	db	'+CVWY000002+DLXZ000001+DMHT000001+DWDZ000020+FFWG000020',nul
	db	'+GCBW000010+GKWZ000004+GNST000001',nul
	db	'XNE33041012+ADTT000003+AHXC000001+AWPJ000001',nul
	db	'XSR03041061-AMHM000001-CCLN000010-CNHL000002-SRVK000009'
	db	'-RFRS000111-svlt000003',nul
	db	nul
hims	db	nul
	db	'ABCDEFGH',nul
	db	' JKLMNOP+2345678',nul
	db	'%RSTUVWXA2345678 ZABCDEF',nul
	db	nul
prec0	db	'D',nul
prec1	db	'04000Y0001000PrePackSizeAAAADescription (to 30 char)',nul
;
; ************************* LOS Emulator ***********************
cls	lxi	h,msg0 !call osput		; Clear Screen
los	lxi	h,msg1 !call osget !jz cls	; "PROGRAM?"
	call	lookup !jz ls1 !call hl !jmp los
ls1	lxi	h,msg2 !call osput !jmp los	; not found
;
osget	shld	savehl
og1	lhld	savehl !mov b,m !inx h !call osput !lxi h,inbuf
og2	call	get !cpi esc !rz
	cpi	29 !jz og5			; [ENTER+]
	cpi	' ' !jc og4 !dcr b !jm og3	; field full
	call	put !call uc !mov m,a !inx h !jmp og2 ; echo
og3	inr	b
og4	mvi	a,bel !call put !jmp og2	; reject
og5	mvi	m,nul !ora a !ret ; Z=0
;
uc	cpi	'a' !rc !cpi 'z'+1 !rnc !sui 20h !ret
;
pad	dcr	b !jm pd1 !mvi m,' ' !inx h !jmp pad ; space fill
pd1	mvi	m,nul !ret			; insert nul

lookup	call	pad !lxi d,name-6		; search pgm library
lo1	lxi	h,6 !dad d !mov a,m !ora a !rz	; pgm not found
	xchg	!push d !call match !pop d !jnz lo1 ; onto next entry
	push	h !lxi h,inbuf !lxi d,prog !lxi b,4 !dw ldir
	pop	h !ori 1 !ret ; Z=0
;
match	lxi	h,inbuf !mvi b,4
ma1	ldax	d !cmp m !inx d !inx h !rnz !dw djnz+(ma1-$-2)*256
	ldax	d !mov l,a !inx d !ldax d !mov h,a !ret
;
hl	pchl
;
init	lxi	h,prog
output	mvi	a,stx !call put
o10	mov	a,m !inx h !ora a !jz o20 !call put !jmp o10
o20	mvi	a,etx !jmp put
;
input	mvi	b,0ffh			; hunt mode
i10	call	service 		; wait for character
	cpi	stx !jz istx		; initialize
	cpi	etx !jz ietx
	cpi	esc !rz !jm i10
	cpi	' ' !rm 		; valid control code
	inr	b !jz input		; no STX yet
	stax	d !inx d !jmp i10	; store char
istx	lxi	d,inbuf !mvi b,0 !jmp i10
ietx	inr	b !jz input !dcr b	; no STX yet
	xra	a !stax d !inr a !ret	; Z=0, M=0
service push	d !call get
	push	psw !mvi a,syn !call put !pop psw !pop d !ret
;
osput	mov	a,m !inx h !ora a !rz !call put
	cpi	cr !jnz osput !mvi a,lf !call put !jmp osput
;
savesp	dw	0
name	dw	'EO','E ',eoe
	dw	'RI','NG',ring
	dw	'FL','OP',flop
	db	0
flag	db	0	; Normal Termination flag
prog	db	'....',nul
msg0	db	can,nul ; Clear Screen
msg1	db	4,cr,'PROGRAM? ',nul
msg2	db	bel,'  NOT FOUND',nul
msg3	db	cr,'TRANSFER ABANDONED',nul
msg4	db	42,cr,'PARMS: ',nul
null	db	nul
savehl	ds	2
inbuf	equ	$	; M18 Task Input Buffer
	end	base

The QX10 Archive