title	System Control for Kaypro 4-83 with CBF ROM
;
cr	equ	0dh
lf	equ	0ah
buffsz	equ	20
;
; DOS calls
coute	equ	2
tstr	equ	9
instrg	equ	10
dreset	equ	13
;
calldos	macro	funct, param
	mvi	a,funct
	if	not nul param
	 lxi	d,param
	endif
	call	dos
	endm
;
	org	0100h
	lxi	h,0
	dad	sp
	shld	savsp
	lxi	sp,savsp
	mvi	a,buffsz
	sta	buff
	lhld	1;		get bios pointer
	lxi	d,21;	MAGIC OFFSET
	dad	d;		make "home" ptr
	shld	dohome + 1
	lhld	1
	lxi	d,24;	MAGIC OFFSET
	dad	d
	shld	dodsksel + 1;	make disk select bios ptr
	calldos	tstr, signon
	calldos	dreset;		reset disk system to avoid later
	mvi	c,0;		  foulups, and select drive A
dodsksel:
	call	$-$;		patched on entry
dohome:	call	$-$;		patched on entry
	shld	sysptr
	mov	a,h
	ora	a
	jz	abort
	mov	a,m
	ora	a
	jz	wtsafe
	cma
	ora	a;		only ff or 0 here
	jz	wtsafe
abort:	calldos	tstr,badsys
	jmp	exit
;
; check write safe flag
wtsafe:	calldos	tstr,wtsafm
	lhld	1
	lxi	d,31h;	MAGIC OFFSET
	dad	d
	call	flipper
	jnz	wrtchk
	mov	a,m
	cma
	ani	1
	mov	m,a
;	"	"
; check write check flag
wrtchk:	calldos	tstr,wchkm
	lhld	sysptr
	call	flipper
	jnz	retry2
	mov	a,m
	cma
	mov	m,a
;	"	"
; show retries and change
retry2:	calldos	tstr, r2msg
	lhld	sysptr
	inx	h
	call	tnum
	cz	alter
;	"	"
; show retry 2 and change
retry1:	calldos	tstr, r1msg
	lhld	sysptr
	inx	h
	inx	h
	call	tnum
	cz	alter
;	"	"
; display softerror counts for drive a, allow reset
errcta:	mvi	a,'A'
	call	couta
	calldos	tstr, errmsg
	lhld	sysptr
	lxi	d,3
	dad	d
	call	terrct
	jnz	errctb
	xra	a
	mov	m,a
	inx	h
	mov	m,a
	inx	h
	mov	m,a
;	"	"
; display softerror counts for drive b, allow reset
errctb:	cnz	crlf
	mvi	a,'B'
	call	couta
	calldos	tstr, errmsg
	lhld	sysptr
	lxi	d,6
	dad	d
	call	terrct
	jnz	exit
	xra	a
	mov	m,a
	inx	h
	mov	m,a
	inx	h
	mov	m,a
;	"	"
; exit system
exit:	lhld	savsp
	sphl
	ret
;
; alter the one byte number at hl^
alter:	push	h
	calldos	tstr,towhat
	calldos	instrg,buff
	call	crlf
	xchg
	inx	h
	mov	a,m
	ora	a
	jz	alter2;		empty line, dont change
	mov	b,a
	mvi	c,0;		accumulator
alter1:	inx	h
	mvi	a,' '
	cmp	m
	jnz	alter3;		non blank
	dcr	b
	jnz	alter1;		skip blanks
alter2:	pop	h
	ret;			empty line or something, no change
alter3:	mov	a,m
	call	qnum
	jc	alter2;		invalid, no change
	mov	c,a
alter4:	inx	h
	dcr	b
	jz	alter5;		have result
	mov	a,m
	call	qnum
	jc	alter5;		terminator, have result
	push	b
	mov	b,a
	mov	a,c
	add	a;		2*
	add	a;		4*
	add	c;		5*
	add	a;		10*
	add	b;		ls digit
	pop	b
	mov	c,a
	jmp	alter4;		someone may want three digits
alter5:	pop	h
	mov	m,a
	ret
;
; check a numeric character.  carry if not, else convert to bin.
qnum:	cpi	'0'
	rc
	cpi	'9'+1
	cmc
	rc
	sui	'0'
	ret;			with carry if invalid
;
; Display one byte value at (hl). Ask for change
tnum:	push	h
	mov	l,m
	mvi	h,0
	call	tdhlzs
	calldos	tstr,chgmsg
	pop	h
	jmp	reply
;
; Display errcounts
terrct:	push	h
	inx	h
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a
	call	tdhlzs
	mov	a,h
	ora	l
	pop	h
	jnz	terr2
	ori	'N';		reset z flag, no change
	ret
terr2:	push	h
	calldos	tstr,ercode
	pop	h
	mov	a,m
	push	h
	lxi	d,erridsz
	lxi	h,errids-erridsz
terr3:	dad	d
	rlc
	jnc	terr3
	xchg
	calldos	tstr
	calldos	tstr,change
	pop	h
	jmp	reply
;
; announce boolean state, allow inversion (0 or 1 only)
; a,f
flipper:
	mov	a,m
	ora	a
	push	d
	lxi	d,onmsg
	jnz	flip1
	lxi	d,offmsg
flip1:	push	h
	calldos	tstr
	pop	h
	pop	d
;	"	"
; Get y/n reply.  Set z flag for y, else reset flag
; a,f
reply:	push	h
	push	d
	push	b
	calldos	tstr,ynmsg
	calldos	instrg,buff
	mvi	a,lf
	call	couta
	xchg
	inx	h
	mov	a,m
	ora	a
	jz	reply2;		empty line
	mov	b,a
reply1:	inx	h
	mvi	a,' '
	cmp	m
	jnz	reply2;		non blank
	dcr	b
	jnz	reply1;		skip blanks
reply2:	mov	a,m;		reply result (may be sz 0 or blank)
	cpi	'y'
	jz	reply3;		yes result
	cpi	'Y'
reply3:	pop	b
	pop	d
	pop	h
	ret
;
; divide hl by ten, remainder to a with flags set
; a,f,h,l
dten:	push	b
	lxi	b,0f00ah;	b=-16, c=10
	xra	a
dten1:	dad	h
	ral
	cmp	c
	jc	dten2
	sub	c
	inx	h
dten2:	inr	b
	jm	dten1
	ora	a
	pop	b
	ret
;
; output hl as decimal number, leading zero suppress
; a,f
tdhlzs:	push	h
	call	dten
	push	psw
	mov	a,l
	ora	h
	cnz	tdhlzs;		recursive
	pop	psw
	pop	h
	adi	'0'
;	"	"
; output a to console
; a,f
couta:	push	d
	push	h
	mov	e,a
	calldos	coute
	pop	h
	pop	d
	ret
;
; crlf to console
crlf:	mvi	a,cr
	call	couta
	mvi	a,lf
	jmp	couta
;
dos:	push	b
	push	d
	mov	c,a
	call	5
	pop	d
	pop	b
	ret
;
signon:	db	'Kaypro 4-83 (cbf ROM) system tuner',cr,lf,'$'
badsys:	db	'Incorrect system ROM for this operation$'
wtsafm:	db	'Write safe (immediate, no blocking) is $'
offmsg:	db	'OFF. Turn it on$'
onmsg:	db	'ON. Turn it off$'
ynmsg:	db	' (y/n)?$'
wchkm:	db	'Write checking (read after write) is $'
r1msg:	db	'Disk read/write retries set at $'
r2msg:	db	'Disk read/write reseeks set at $'
chgmsg:	db	'. Change it$'
towhat:	db	'To what ? $'
errmsg:	db	': soft error count is $'
ercode:	db	', last error was: $'
change:	db	'. Reset it$'
errids:	db	'NotReady$$$$';	bit 7 - not ready
	db	'WrtProtect$$';	    6 - write protect
	db	'WrtFaulT$$$$';	    5 - write fault
	db	'RcdNotFound$';	    4 - record not found
	db	'CRC Error$$$';	    3 - CRC error
	db	'LostData$$$$';	    2 - data overrun
	db	'DataRequest$';	    1 - data not supplied
	db	'Busy$$$$$$$$';	bit 0 - controller busy
erridsz	equ	($-errids)/8;	size of each message (all same)
;
buff	ds	buffsz+1;	input buffer
sysptr:	ds	2
	ds	64;		run time stack
savsp:	ds	2;		save entry stack
;
	end