; **** SYSTEM UTILITIES ****
base	equ	1000h
suspend equ	0109h	; Block task voluntarily
char	equ	010ch	; Keystroke -> A
vdu	equ	010fh	; A -> Screen
wait	equ	0199h	; Block Task until Event (DE)
;
bdos	equ	0005h	; bdos entry point
romcg	equ	0fe57h	; 0ffh=use ROM char gen
ixy	equ	0fe75h	; Cursor col,row
ans	equ	0fee0h	; FDC Result Phase data area
fdint	equ	0feech	; -> Floppy Disc Interrupt Handler
spt	equ	9	; IBM Sectors/track
fdb	equ	0e300h	; IBM diskette transfer buffer (1K)
ev0	equ	0e701h	; Event List
dir	equ	0c000h	; -> IBMpc Directory Entry save area (32 bytes)
fat	equ	0c020h	; -> IBM File Allocation Table save area (534 bytes)
;
; Z80 OP Codes--
djnz	equ	00010h
ldir	equ	0b0edh
sspd	equ	073edh	; LD (nn),SP
lspd	equ	07bedh	; LD SP,(nn)
;
; Inter-Task Communication--
ctl	equ	01d0h	; System Control Block
mstate	equ	ctl+12	; B0: Electronic (not Terminal) Mode
light	equ	ctl+25	; Cursor Control
;
; ASCII codes--
nul	equ	00h
bel	equ	07h
bs	equ	08h
lf	equ	0ah
ff	equ	0ch
cr	equ	0dh
esc	equ	1bh
gs	equ	1dh	; [left arrow]
us	equ	1fh	; [down arrow]
fill	equ	'_'	; get field filler
time	equ	7fh
;
itrk	equ	0	; Base Track for Spool File
isec	equ	2	; Base Sector for Spool File
sekdsk	equ	0fc40h	; Seek Disc Id, Track No, Sector No
dmaadr	equ	0fc54h	; Memory Address of transfer
;
	org	base
ymd	lxi	h,io	  !shld 0131h	; workspace
	lxi	h,clock   !shld 0134h
	lxi	h,format  !shld 0137h
	lxi	h,stow	  !shld 0140h
	lxi	h,spool   !shld 0143h
	lxi	h,unspool !shld 0146h
	lxi	h,reset   !shld 017ch
	lxi	h,mark	  !shld 0191h
	lxi	h,byte	  !shld 0197h
	lxi	h,label   !shld 01c2h
	lxi	h,nextdir !shld 01a6h
	ret
;
esce	push	psw !mvi a,esc !push d !call vdu !pop d !jmp $+4
vdue	push	psw !mov a,e !call vdu !pop psw !ret
format	call	io !mov a,m !cpi 0e0h !jnz format !ret
;
io	call	suspend !dw 05bedh,ixy ; LD DE,(ixy) ; initial cursor coord
	push	d !call before !push d !call line !pop d !call after
	mov	a,d !ora e !jz io1	; D=effects word, E=get length
	mov	a,e !ora a !cnz get !xthl !call locif !xthl
io1	pop	d !dcx h !mov a,m !inx h !ora a !jnz io ; onto next string
	lda	light !ora a !mvi e,'3' !cm esce ; Cursor On
	lxi	d,ascii !lda ln !ret
;
get	sta	ln !push b !push h !lhld ixy !shld gxy
field	lhld	gxy !call locate !lda ln !mov b,a !mov c,a !mvi a,fill
	call	vdu !dw djnz-5*256	; fill field
	call	locate !lxi h,ascii	; B=0, C=field length
x1	call	key !cpi ' ' !jc x3 !cpi 7fh !jnc x9
	mov	e,a !mov a,c !cmp b !jz x9 !mov a,e
	mov	m,a !inx h !inr b !mvi e,'6' !call esce ; highlight on
	call	vdu !mvi e,'7' !call esce !jmp x1	; highlight off
x3	cpi	cr !jz x5 !cpi us !jz x5
	cpi	bs !jz x6 !cpi gs !jz x6
	cpi	esc !jz x7
x9	mvi	a,bel !call vdu !jmp x1 ; reject char
x5	mvi	m,nul !call pad 	; space fill screen field
	mvi	a,2 !sta mf !mov a,b !sta ln !pop h !pop b !ret
x6	mov	a,b !ora a !jz x9 !dcr b !dcx h !mvi a,bs !call vdu
	mvi	a,fill !call vdu !mvi a,bs !call vdu !jmp x1
x7	mov	a,b !ora a !jnz field	; restart field
	pop	h !pop b !pop h !pop h !call locif
	lda	light !ora a !mvi e,'3' !cm esce ; Cursor On
	lxi	h,mf !mov a,m !mvi m,1 !ora a !rar ; Z=0, C=1st io since mark
	dw	04bedh,mf+7,07bedh,mf+5 ; LD BC,(mf+7) ; LD SP,(mf+5)
	lhld	mf+3 !xthl !lhld mf+1 !ret
;
key	push	h !lxi h,light !dcr m !mvi e,'3' !call esce ; cursor on
	call	char !inr m !pop h !mvi e,'2' !jmp esce ; cursor off
;
pad	mov	a,c !sub b !rz !mov c,b !mov b,a !mvi a,' '
	call	vdu !dw djnz-5*256
	mov	b,c !ret
;
mark	mvi	a,1 !sta mf !shld mf+1 !xthl !shld mf+3 !xthl
	dw	073edh,mf+5,043edh,mf+7 ; LD (mf+5),SP ; LD (mf+7),BC
	xra	a !ret ; Z=1, C=0
;
locif	mov	a,b !ora a !rz !dw 04bedh,ixy ; LD BC,(ixy) ; current loc
locate	mvi	e,'=' !call esce
	mov	a,h !adi 1fh !call vdu !mov a,l !adi 1fh !jmp vdu
;
bump	mov	a,b !ora a !jz $+4 !inr b !mvi e,0 ; onto next row
line	mov	a,b !ora a !cz scroll !cnz goto ; position cursor
text	mov	a,m !inx h !ora a !rz !jm repeat
	cpi	cr !jz bump !cpi lf !jz bump
	cpi	time !jz now !call vdu !jmp text
repeat	ani	7fh !rz !push b !mov b,a !mov a,m !inx h ; B=count, A=char
	push	h !lxi h,romcg !dcr m !call vdu !dw djnz-6*256
	pop	h !pop b !jmp text
now	push	h !push b !lxi d,ascii !call clock !lxi h,ascii !mvi b,22
	mov	a,m !inx h !call vdu !dw djnz-7*256 ; insert date & time
	pop	b !pop h !jmp text
;
scroll	mov	a,c !ora a !rz !mvi a,lf	; don't move cursor
	call	vdu !dcr c !jnz $-4 !inr c !mvi a,cr !jmp vdu
;
goto	mov	a,c !ora a !jm $+6 !jnz xy	; auto-centre
	push	h !call sum !dw 02bcbh ; SRA E	; E=len(text+get)/2
	pop	h !call mid !sub e
xy	push	psw !mvi e,'=' !call esce
	mov	a,b !adi 1fh !call vdu !pop psw !adi 1fh !jmp vdu
;
su2	mvi	a,22		       ; add length of time string
su0	add	e !mov e,a
sum	mov	a,m !inx h !ora a !rz !jm su1
	cpi	cr !rz !cpi lf !rz !cpi time !jz su2 !inr e !jmp sum
su1	ani	7fh !rz !inx h !jmp su0 ; add repeated chars
;
mid	dw	079cbh ; BIT 7,C	; half width
	mvi	a,40 !rz !dw 071cbh ; BIT 6,C
	mvi	a,20 !rz !mvi a,60 !ret ; centre left/right
;
getxy	mvi	e,0 !mov a,m !ani 0e0h !rnz ; BC has cursor coords
	mov	a,m !cpi esc !jnz $+6 !inx h !mov e,m !inx h ; pickup keyln
	mov	b,m !inx h !mov c,m !inx h !ret
;
before	mvi	e,'2' !call esce	; cursor off
	call	getxy !mov d,m !mov a,d !ora a !rp
	push	d			; D=effects word, E=get length
	ani	60h !cpi 60h !mvi a,ff !cz vdu !mov a,m !inx h ; clear screen
	mvi	e,'6' !rar !cc esce	; B0 Highlight on
	mvi	e,'0' !rar !cc esce	; B1 Reverse on
	mvi	e,'8' !rar !cc esce !pop d !ret ; B2 Blink on
;
after	mov	a,d !ora a !rp !push d	; no effects
	mvi	e,'7' !rar !cc esce	; B0 Highlight off
	mvi	e,'1' !rar !cc esce	; B1 Reverse off
	mvi	e,'9' !rar !cc esce	; B2 Blink off
	mvi	e,bel !rar !cc vdue	; B3 Beep
	rar	!cc fake !call clr !pop d !ret
clr	ani	03h !rz !cpi 03h !rz !ani 02h ; clear to eol or eos
	mvi	a,05h !jz $+5 !mvi a,1ah !jmp vdu
;
fake	push	psw !push h !lxi h,sham ; output fake cursor
fk1	mov	a,m !inx h !ora a !jz fk2 !call vdu !jmp fk1
fk2	pop	h !pop psw !ret
;
clock	push	b !push h !push d	; save target pointer
ck0	lxi	h,ymd !lxi d,ram !lxi b,0e3ch !mvi a,10 ; read 7 RAM bytes
ck1	out	3dh !dw 070edh ; IN F,(C) ; restart if update in progress
	jm	ck0 !xchg !inr c !dw 0a3edh ; OUTI ; RAM Address
	xchg	!dcr c !dw 0a2edh ; INI ; RAM Data
	jnz	ck1 !pop d
	lda	ymd+6 !lxi h,dtab-4 !call m4 ; Day of Week (1=Sunday)
	lda	ymd+2 !call m2 !mvi a,' ' !stax d !inx d ; Day of Month
	lda	ymd+1 !cpi 10h !jm $+5 !sui 6 !lxi h,mtab-4 !call m4 ; Month
	lda	ymd   !call m2 !mvi a,' ' !stax d !inx d ; Year
	lda	ymd+3 !call m2 !mvi a,':' !stax d !inx d ; Hour
	lda	ymd+4 !call m2 !mvi a,':' !stax d !inx d ; Minute
	lda	ymd+5 !call m2 !pop h !pop b !ret	 ; Second
m4	rlc	!rlc !mvi b,0 !mov c,a !dad b !lxi b,4 !dw ldir
	ret
m2	push	psw !rlc !rlc !rlc !rlc !call m1 !pop psw ; unpack BCD
m1	ani	0fh !ori '0' !stax d !inx d !ret
dtab	db	'Sun Mon Tue Wed Thu Fri Sat '
mtab	db	'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec '
ram	db	9,8,7,4,2,0,6	; list of clock RAM bytes to read
;
; ************************* Disc System **************************
;
reset	lxi	h,label !lxi d,f1a !lxi b,11 !dw ldir ; System Disc name
	lxi	d,sdn !lxi b,14 !dw ldir	; Disc No & extension
rs1	mvi	c,25 !call bdos !push psw	; save default drive
	mvi	c,13 !call bdos !pop psw	; reset CP/M disc system
	mov	e,a !mvi c,14 !call bdos	; select disc
	lda	sdn+2 !ora a !jnz rs2		; IBMpc format not allowed
	call	id !lda ans+7 !cpi 2 !jz ibm	; assume IBMpc format
rs2	lxi	b,1 !lxi d,label !call read	; Drive B Track 0 Sector 1
	lhld	disc !ora a !dw 05bedh,sdn,052edh ; LD DE,(sdn) ; SBC HL,DE
	rz					; System Disc No OK
rs3	lxi	h,f1 !call io !call slide !call slide ; remove & replace B
	call	rdy !lxi h,f0 !call io !jmp rs1 ; check new disc
;
ibm	lxi	h,1 !call ibmr !lxi d,fat !lxi b,534 !dw ldir ; read FAT
	xra	a !sta label !call scan !rnz !jmp rs3 ; file not found
;
scan	lxi	h,5				; directory scan start sector
sn1	shld	label+1 !call ibmr !mvi b,32	; read 32 entries
sn2	mov	a,m !ora a !rz !cpi 0e5h !jz sn3; unused or deleted entry
	call	match !jnz sn3 !ani 01eh !jnz sn3 ; wrong name or attributes
	shld	label+3 !mov a,b !sta label+5	; save for nextdir rtn
	lxi	d,dir !lxi b,32 !dw ldir	; setup directory entry
	lxi	d,ncl !lxi h,dir+26 !lxi b,6 !dw ldir ; 1st cluster, file size
	lxi	h,fdb+1024 !shld pin		; force read 1st cluster
	lxi	h,dir !ori 1 !ret		; Z=0 (IBMpc format)
nextdir lda	label !ora a !jz $+5 !xra a !ret; not IBMpc format
	lhld	label+1 !call ibmr		; reread directory
	lhld	label+3 !lda label+5 !mov b,a	; resume scan
sn3	lxi	d,32 !dad d !dw djnz+(sn2-$-2)*256
	lhld	label+1 !inx h !inx h !jmp sn1	; try next sectors
;
match	push	h !push b !lxi d,sdn+3 !mvi b,11; compare 11 bytes
ma1	ldax	d !cpi '?' !jz $+7 !cmp m !jnz ma2
	inx	h !inx d !dw djnz+(ma1-$-2)*256
	mov	a,m				; attributes
ma2	pop	b !pop h !ret			; Z=found
;
; Advance Cluster Number--
next	dw	05bedh,ncl ; LD DE,(ncl)	; pickup current cluster no
	lxi	h,0f008h !dad d !rc !mov h,d !mov l,e !push h ; EOF if >=ff8h
	dad	d !dad d !dw 03ccbh,01dcbh ; SRL H ; RR L ; *3/2 = offset
	push	psw !lxi d,fat !dad d !mov e,m !inx h !mov d,m ; pickup next
	xchg	!shld ncl !lxi h,ncl+1 !pop psw !jc odd
	mvi	a,0fh !ana m !mov m,a !pop h !ret ; (C=0) discard left digit
odd	xra	a !dw 067edh ; RRD
	dcx	h !dw 067edh ; RRD		; discard right digit
	pop	h !ret				; (C=0)
;
slide	call	sense !ani 40h !jz $-5		; wait till wrprot
	call	sense !ani 40h !jnz $-5 !ret	; wait till not wrprot
;
byte	push	h !push b !lhld roc !mov a,h !ora l !jnz by1 !xchg
	lhld	roc+2 !mov a,h !ora l !jz eof !dcx h !shld roc+2 !xchg
by1	dcx	h !shld roc !lhld pin !xchg
	lxi	h,-fdb-1024 !dad d !xchg !cc ibmn !jc eof
	ori	1 !mov a,m !inx h !shld pin !pop b !pop h !ret ; Z=0
eof	pop	b !pop h !xra a !ret ; Z=1
;
ibmn	call	next !rc !dad h !lxi d,8 !dad d ; C=EOF
ibmr	call	prep !lxi d,044c6h !call mode	; Read 1024 bytes
ibmt	call	seek !call fdd !cnz fdd !cnz fdd !cnz fdd ; 4 tries
	lxi	h,fdb !rz !call wipe !jmp ibmt	; go again
;
ibmw	call	prep
iw1	lxi	d,048c5h !call mode !call ibmt	; Write 1024 bytes
	lxi	d,040c6h !call mode !call fdd !cnz fdd !rz !jmp iw1 ; Verify
;
fdd	lxi	h,fdb !lxi b,2*512		; Buffer addr, length
	lda	fdc4-1 !out 4bh !dcx b		; DMA Mode Register
	mov	a,l !out 40h !mov a,h !out 40h	; DMA Ch 0 Base
	mov	a,c !out 41h !mov a,b !out 41h	; DMA Ch 0 Word
	mvi	a,60h !out 48h !mvi a,0 !out 4fh; DMA Unmask
	lxi	h,fdc4 !jmp exec		; FDD Read/Write/Verify
;
id	lxi	h,fdc2 !call exec !cnz exec !rz ; read any id, 2 tries
	call	wipe !jmp id			; go again
;
recal	lxi	h,fdc3 !call exec !rz !jmp recal; Head to Trk 0
seek	lxi	h,fdc5 !call exec !cnz exec !rz ; Head to Trk n, 2 tries
	call	wipe !jmp seek			; go again
;
wipe	call	recal !lxi h,fdc6 !call exec !rz !jmp wipe ; Trk 0, Trk 39
;
exec	push	h !lhld fdint !shld 0fd9ah	; ditch Epson interrupt rtn
	call	rdy !pop  h !push h !call fdc	; issue command when ready
	lxi	d,ev0 !call wait !lxi h,0fc02h !shld 0fd9ah
	lda	ans+1 !ani 0c0h !pop h !ret	; Z=successful
;
rdy	out	30h !lxi h,fdc1 !call fdc	; Motor On, sense status
	ani	20h !rnz !call suspend !jmp rdy
;
sense	call	suspend !lxi h,fdc1		; ST3 -> A
fdc	mov	b,m !inx h !di			; command to Floppy Disc
fc1	in	34h !ora a  !jp fc1		; wait for RQM
	ani	40h !jz fc2 !in 35h !ei !ret	; read ST3 (or ST0)
fc2	mov	a,m !inx h !out 35h !dw djnz+(fc1-$-2)*256
	ei	!ret
;
; Convert IBM Sector in HL to Cyl, Head, Rec--
prep	lxi	b,spt*2 !call div !sta fdc4+3 !sta fdc5+3 ; Cylinder
	lxi	b,spt !call div !sta fdc4+4	; Head
	rlc	!rlc !ori 1 !sta fdc4+2 !sta fdc5+2 ; Drive B
	mov	a,l !inr a !sta fdc4+5 !ret	; Record
mode	mov	a,d !sta fdc4-1 !mov a,e !sta fdc4+1 !ret
;
div	mvi	a,0ffh				; A=HL/BC, remainder to HL
div1	inr	a !ora a !dw 042edh ; SBC HL,BC
	jnc	div1 !dad b !ret
;
fdc1	db	3,04h,1,0			; Sense Status: Drive B
fdc2	db	2,4ah,01h			; Read ID: Head 0, Drive B
fdc3	db	2,07h,01h			; Recalibrate: Drive B
	db	0				; DMA Mode Register
fdc4	db	9,0c6h,01h,0,0,1,2,spt,2ah,0ffh ; Read: Drive B, Sector 0
fdc5	db	3,0fh,01h,0			; Seek: Drive B, Cyl 0
fdc6	db	3,0fh,01h,39			; Seek: Drive B, Cyl 39
;
; Write System Control Record--
stow	push	psw !push b !push h
	lxi	d,label !ldax d !ora a !jz ibms
	lxi	b,1 !mvi a,1 !call write	; CP/M Unblocked mode
	pop	h !pop b !pop psw !ret
ibms	lhld	label+1 !push h !call ibmr	; Read Directory sector
	lhld	label+3 !xchg !lxi h,dir !lxi b,32 !dw ldir ; Update entry
	pop	h !call ibmw !pop h !pop b !pop psw !ret ; Rewrite
;
; Write (DE) -> Next Sector--
spool	push	psw !push b !push h
	lhld	strk !mov b,l	; = next track
	lda	ssec !mov c,a	; = next sector
	xra	a !call write	; Standard Format mode
; Update Sector & Track for next call--
	inr	c !lda tsec !cmp c !jnz sp1
; Advance to next track--
	lhld	strk !inx h !shld strk !shld ltrk !mvi c,0
; Update sector--
sp1	mov	a,c !sta ssec !sta lsec
	pop	h !pop b !pop psw !ret
;
; Read Oldest Sector -> (DE)--
unspool push	b !push h
	lhld	utrk !mov b,l	; = next track
	lda	usec !mov c,a	; = next sector
; Check for end-of-data--
	lda	ssec !cmp c !jnz us1	; more data exists
	lhld	strk !mov a,l !cmp b !jnz us1 ; more data
; Reset Spool System--
	lhld	btrk !shld strk !shld utrk
	lda	bsec !sta  ssec !sta  usec
	xra	a !jmp us2	; set Z flag
us1	call	read
; Update Sector & Track for next call--
	inr	c !lda tsec !cmp c !jnz us3
; Advance to next track--
	lhld	utrk !inx h !shld utrk !mvi c,0
; Update sector--
us3	mov	a,c !sta usec !inr a	; clear Z flag
us2	pop	h !pop b !ret
;
; Read Drive B: Track B Sector C -> (DE)
read	xchg	!shld dmaadr
	lxi	h,sekdsk !mov d,m !mvi m,1 !inx h ; Drive B:
	mov	m,b !inx h !mvi m,0 !inx h	; Track B
	mov	m,c !push b !push d		; Sector C
	call	0f627h !pop d !pop b		; Read Sector
	lxi	h,sekdsk !mov m,d !ret		; ignore any errors
;
; Write Mode A (DE) -> Drive B Track B Sector C
write	xchg	!shld dmaadr
	lxi	h,sekdsk !mov d,m !mvi m,1 !inx h ; Drive B:
	mov	m,b !inx h !mvi m,0 !inx h	; Track 0B
	mov	m,c !push b !push d		; Sector C
	mov	c,a !call 0f62ah !pop d !pop b	; Write Sector
	lxi	h,sekdsk !mov m,d !ret		; ignore any errors
;
sham	db	esc,'0',esc,'8 ',esc,'9',esc,'1',nul
f0	db	1,1,0a0h,nul		; clear Status Line
f1	db	1,1,0abh,' Please put '
f1a	db	'........... Diskette gently in Drive B ',nul
;
; System Control Record (Spool Trk 0 Sec 1)--
label	db	'SPOOL      ' ; Default Name
disc	dw	10	; Default Disc Number
ttrk	dw	40	; 40 (Number of Tracks)
tsec	ds	1	; 64 (Number of Sectors per Track)
btrk	ds	2	; 0 (Base Track for Spool file)
bsec	ds	1	; 2 (Base Sector for Spool file)
strk	ds	2	; 0 Spool:   Track for next sector
ssec	ds	1	; 2 Spool:   Next Sector
utrk	ds	2	; 0 Unspool: Track for next sector
usec	ds	1	; 2 Unspool: Next Sector
ltrk	ds	2	; 0 DLU:     Spool Reset Track
lsec	ds	1	; 2 DLU:     Spool Reset Sector
	ds	4
pswd	ds	96
;
mf	ds	9	; mark flag, HL, rtn, SP, BC
ln	ds	1	; max keystrokes
gxy	ds	2	; cursor coords at entry to get
pin	ds	2	; IBMpc file: input pointer
ncl	ds	2	; IBMpc file: next cluster number
roc	ds	4	; IBMpc file: remains of byte count
sdn	ds	14	; System Disc Number & IBMpc extension
ascii	equ	$	; input buffer
	end	base

The QX10 Archive