CP/M 3 BIOS for Bondwell 14

;
;			CP/M 3 BIOS for Bondwell 14
;
;
; Assemble with a relocating assembler to produce BIOS3.REL, then use
; the DRI linker LINK.COM to produce BNKBIOS3.SPR
;
;			link bnkbios3[b]=bios3
;
; To create CPM3.SYS run GENCPM using all defaults when prompted
; except for the following -
;
;	number of console lines 	#25
;	top page of memory		f7
;	common memory base page 	80
;	number of memory segments	2
;	memory segment 0		(00,50,00)
;	memory segment 1		(10,70,02)
;
; The first 4k bytes of bank 2 is reserved, the space being used to
; hold a copy of CCP.COM for quick warm starts.
;

day	equ	30
mon	equ	12
year	equ	94

	.z80			; required for M80 assembler

no	equ	0
yes	equ	not no

errors	equ	no		; display BIOS error message
lcase	equ	yes		; if caps-lock, change upper to lower
minbios	equ	no		; minimum size BIOS

maxtry	equ	10		; number re-tries on disk-error

; disk definitions

bw12	defl	yes		; Bondwell 12
sv3	defl	yes		; Spectravideo 318/328
kay2	defl	yes		; Kaypro II
osb1	defl	yes		; Osborne 1
amp4	defl	yes		; Ampro 48 tpi DS
kay4	defl	yes		; Kaypro 4/10

	 if	minbios		; remove unwanted disk definitions
bw12	defl	no
sv3	defl	no
kay2	defl	no
osb1	defl	no
amp4	defl	no
kay4	defl	no
	 endif

bell	equ	7
lf	equ	10
cr	equ	13

ccp	equ	100h
screen	equ	0f800h		; screen ram
cols	equ	80		; # screen columns
rows	equ	25		; # screen rows

; system control block

	extrn	@civec,@covec	; console input/output vectors
	extrn	@aivec,@aovec	; auxiliary input/output vectors
	extrn	@lovec		; list output vector
	extrn	@mxtpa		; top of tpa (address 6,7)

; ports

crtcr	equ	10h		; 6845 CRTC control reg
crtdr	equ	crtcr+1		; data reg

fdcst	equ	20h		; 765 FDC status reg
fdcdr	equ	fdcst+1		; data reg

pddra	equ	3ch		; 6821 PIA DDR port A
pcra	equ	pddra+1		; control reg A
pddrb	equ	pcra+1		; DDR port A
pcrb	equ	pddrb+1		; control reg A

siodra	equ	40h		; Z80 SIO/0
siocra	equ	siodra+1	;
siodrb	equ	siocra+1	;
siocrb	equ	siodrb+1	;

audio	equ	50h		; MC1408 8-bit D-A

timer0	equ	60h		; 8253 timer 0
timer1	equ	timer0+1	; timer 1
timer2	equ	timer1+1	; timer 2
timercr	equ	timer2+1	; control reg

; BIOS jump table

?boot:	jp	boot		; 0
?wboot:	jp	wboot		; 1
	jp	const		; 2
	jp	conin		; 3
?cono:	jp	conout		; 4
	jp	list		; 5
	jp	auxout		; 6
	jp	auxin		; 7
	jp	home		; 8
	jp	seldsk		; 9
	jp	settrk		; 10
	jp	setsec		; 11
	jp	setdma		; 12
	jp	read		; 13
	jp	write		; 14
	jp	listst		; 15
	jp	sectrn		; 16

; CP/M3 BIOS calls

	jp	conost		; 17  conout status
	jp	auxist		; 18  aux in status
	jp	auxost		; 19  aux out status
	jp	devtbl		; 20  addr of device definition table
	jp	?cinit		; 21  change baud rate of device
	jp	getdrv		; 22  addr of disk drive table
	jp	multio		; 23  set multiple record count
	jp	flush		; 24  flush disk caching
	jp	?move		; 25  block move
	jp	?time		; 26  time/date
?bnksel:
	jp	bnksel		; 27  select bank for code execution
	jp	setbnk		; 28  select different bank for i/o
	jp	?xmove		; 29  set source/destination banks

; user specified calls

	jp	?fnkeys		; 30  returns addr of function key table
	jp	0000		; 31  spare
	jp	0000		; 32  spare

boot:	di			; disable interrupts
	ld	sp,boot$stack
	ld	c,15		; initialise all 16 character devices
c$init$loop:
	push	bc
	call	?cinit
	pop	bc
	dec	c
	jp	p,c$init$loop

	call	?init		; additional system initialisation
				; and sign-on message
	ld	bc,16*256+0
	ld	hl,@dtbl
d$init$loop:
	push	bc
	ld	e,(hl)
	inc	hl
	ld	d,(hl)
	inc	hl
	ld	a,e
	or	d
	jr	z,d$init$next
	push	hl
	ex	de,hl
	dec	hl
	dec	hl
	ld	a,(hl)
	ld	(@rdrv),a
	ld	a,c
	ld	(@adrv),a
	dec	hl
	ld	d,(hl)
	dec	hl
	ld	e,(hl)
	ex	de,hl
	call	ipchl
	pop	hl
d$init$next:
	pop	bc
	inc	c
	dec	b
	jr	nz,d$init$loop
	jr	boot$1

boot$1:	call	set$jumps
	call	?ldccp

	ld	hl,cboot	; set BIOS cold start vector
	ld	(?boot+1),hl
	ld	hl,auto-1	; auto-execute string
	ld	(nxtchr),hl
	ld	a,16
	ld	(ccount),a
	ei			; enable interrupts
	jp	ccp		; enter CP/M

auto:	db	'AUTORUN',cr
	db	0

cboot:	di
	in	a,(00h)		; cold boot from Rom
	in	a,(02h)
	jp	0000h

wboot:	di
	ld	sp,boot$stack
	call	set$jumps	; set zero page jumps
	call	?rlccp		; load first time CCP
	ei			; enable interrupts
	jp	ccp		; enter CP/M

set$jumps:
	ld	a,1
	call	?bnksel
	ld	a,0c3h		; set up jumps
	ld	(0000),a
	ld	(0005),a
	ld	hl,?wboot	; BIOS warm start vector
	ld	(0001),hl
	ld	hl,(@mxtpa)	; BDOS vector
	ld	(0006),hl
	ret

	ds	64		; stack space

boot$stack	equ	$

devtbl:	ld	hl,@ctbl
	ret

getdrv:	ld	hl,@dtbl
	ret
;
; Output to logical devices -  conout, auxout, lst
;
conout:	ld	hl,(@covec)
	jr	out$scan

auxout:	ld	hl,(@aovec)
	jr	out$scan

list:	ld	hl,(@lovec)
out$scan:
	ld	b,0
co$next:
	add	hl,hl
	jr	nc,not$out$device
	push	hl
	push	bc
not$out$ready:
	call	coster
	or	a
	jr	z,not$out$ready
	pop	bc
	push	bc
	call	?co
	pop	bc
	pop	hl
not$out$device:
	inc	b
	ld	a,h
	or	l
	jr	nz,co$next
	ret
;
; Get output status of logical device - conout, auxout, lst
;
conost:	ld	hl,(@covec)
	jr	ost$scan

auxost:	ld	hl,(@aovec)
	jr	ost$scan

listst:	ld	hl,(@lovec)
ost$scan:
	ld	b,0
cos$next:
	add	hl,hl
	push	hl
	push	bc
	ld	a,0ffh
	call	c,coster
	pop	bc
	pop	hl
	or	a
	ret	z
	inc	b
	ld	a,h
	or	l
	jr	nz,cos$next
	or	0ffh
	ret

; check for output device ready, including xon/xoff

coster:	ld	l,b
	ld	h,0
	push	hl
	add	hl,hl		; *8 (8 bytes per physical device)
	add	hl,hl
	add	hl,hl
	ld	de,@ctbl+6	; get byte
	add	hl,de
	ld	a,(hl)
	and	mbx		; xon/xoff
	pop	hl
	jp	z,?cost
	ld	de,xofflist
	add	hl,de
	call	cist1
	ld	a,(hl)
	call	nz,ci1
	cp	17		; ctl-q
	jr	nz,not$q
	ld	a,0ffh
not$q:	cp	19		; ctl-s
	jr	nz,not$s
	ld	a,0
not$s:	ld	(hl),a
	call	cost1
	and	(hl)
	ret

xofflist:
	db	-1,-1,-1,-1,-1,-1,-1,-1
	db	-1,-1,-1,-1,-1,-1,-1,-1

cist1:	push	bc		; get input status, save BC and HL
	push	hl
	call	?cist
	pop	hl
	pop	bc
	or	a
	ret

cost1:	push	bc		; get output status, save BC and HL
	push	hl
	call	?cost
	pop	hl
	pop	bc
	or	a
	ret

ci1:	push	bc		; get input, save BC and HL
	push	hl
	call	?ci
	pop	hl
	pop	bc
	ret
;
; Get status of logical input device - conin, auxin
;
const:	ld	hl,(@civec)
	jr	ist$scan

auxist:	ld	hl,(@aivec)
ist$scan:
	ld	b,0
cis$next:
	xor	a
	add	hl,hl
	call	c,cist1
	or	a
	ret	nz
	inc	b
	ld	a,h
	or	l
	jr	nz,cis$next
	xor	a
	ret
;
; Input character from logical device - conin, auxin
;
conin:	ld	hl,(@civec)
	jr	in$scan

auxin:	ld	hl,(@aivec)
in$scan:
	push	hl
	ld	b,0
ci$next:
	xor	a
	add	hl,hl
	call	c,cist1
	or	a
	jr	nz,ci$rdy
	inc	b
	ld	a,h
	or	l
	jr	nz,ci$next
	pop	hl
	jr	in$scan

ci$rdy:	pop	hl
	jp	?ci

; vectored calls

ipchl:	jp	(hl)

; print message at (hl) until null byte, save BC and DE

?pmsg:	push	bc
	push	de
pmsg$loop:
	ld	a,(hl)
	or	a
	jr	z,pmsg$exit
	ld	c,a
	push	hl
	call	?cono
	pop	hl
	inc	hl
	jr	pmsg$loop
pmsg$exit:
	pop	de
	pop	bc
	ret

; report disk error - drive, track, sector

	 if	errors
?pderr:	ld	hl,drv$msg
	call	?pmsg
	ld	a,(@adrv)
	add	a,'A'
	ld	c,a
	call	?cono
	ld	hl,trk$msg
	call	?pmsg
	ld	hl,(@trk)
	call	?pdec
	ld	hl,sec$msg
	call	?pmsg
	ld	hl,(@sect)
	call	?pdec
	ret

drv$msg:
	db	cr,lf,bell
	db	'BIOS ERROR ON '
	db	0
trk$msg:
	db	': T-'
	db	0
sec$msg:
	db	', S-'
	db	0
	 endif

; print binary number (hl)

	 if	errors
?pdec:	ld	bc,table10
	ld	de,-10000
next:	ld	a,'0'-1
pdecl:	push	hl
	inc	a
	add	hl,de
	jr	nc,stoploop
	inc	sp
	inc	sp
	jr	pdecl
stoploop:
	push	de
	push	bc
	ld	c,a
	call	?cono
	pop	bc
	pop	de
	pop	hl
	ld	a,(bc)
	ld	e,a
	inc	bc
	ld	a,(bc)
	ld	d,a
	inc	bc
	ld	a,e
	or	d
	jr	nz,next
	ret

table10:
	dw	-1000,-100,-10,-1,0
	 endif

; select bank for code execution and default dma

bnksel:	ld	(@cbnk),a
	jp	?bank

; select disk drive (c),  return disk parameter header (hl)

seldsk:	ld	a,c
	ld	(@adrv),a
	ld	l,c
	ld	h,0
	add	hl,hl
	ld	bc,@dtbl
	add	hl,bc
	ld	a,(hl)
	inc	hl
	ld	h,(hl)
	ld	l,a
	or	h
	ret	z
	ld	a,e
	and	l
	jr	nz,not$first$select
	push	hl
	ex	de,hl
	ld	hl,-2
	add	hl,de
	ld	a,(hl)
	ld	(@rdrv),a
	ld	hl,-6
	add	hl,de
	ld	a,(hl)
	inc	hl
	ld	h,(hl)
	ld	l,a
	call	ipchl
	pop	hl
not$first$select:
	ret

;	set disk to logical home

home:	ld	bc,0000

;	set disk track

settrk:	ld	l,c
	ld	h,b
	ld	(@trk),hl
	ret

; Set disk sector

setsec:	ld	l,c
	ld	h,b
	ld	(@sect),hl
	ret

; Set disk I/O memory address

setdma:	ld	l,c
	ld	h,b
	ld	(@dma),hl
	ld	a,(@cbnk)

; Select different bank for disk I/O DMA operations

setbnk:	ld	(@dbnk),a
	ret

; Translate sequential to physical sector

sectrn:	ld	l,c
	ld	h,b
	ld	a,d
	or	e
	ret	z
	ex	de,hl
	add	hl,bc
	ld	l,(hl)
	ld	h,0
	ret

; Read physical sector

read:	ld	hl,(@adrv)
	ld	h,0
	add	hl,hl
	ld	de,@dtbl
	add	hl,de
	ld	a,(hl)
	inc	hl
	ld	h,(hl)
	ld	l,a
	push	hl
	ld	de,-8
	add	hl,de
	jr	rw$common

; Write physical sector

write:	ld	hl,(@adrv)
	ld	h,0
	add	hl,hl
	ld	de,@dtbl
	add	hl,de
	ld	a,(hl)
	inc	hl
	ld	h,(hl)
	ld	l,a
	push	hl
	ld	de,-10
	add	hl,de

rw$common:
	ld	a,(hl)
	inc	hl
	ld	h,(hl)
	ld	l,a
	pop	de
	dec	de
	dec	de
	ld	a,(de)
	ld	(@rdrv),a
	inc	de
	inc	de
	jp	(hl)

; Set multiple record count for disk i/o

multio:	ld	(@cnt),a
	ret

; Flush BIOS maintained disk cache

flush:	xor	a
	ret

@adrv:	db	0		; currently selected drive
@rdrv:	db	0		; controller relative drive
@trk:	dw	0		; current logical track
@sect:	dw	0		; current logical sector
@dma:	dw	0		; current dma address
@cnt:	db	0		; record count for multisector transfer
@dbnk:	db	0		; bank for dma operations
@cbnk:	db	0		; bank for processor operations

; additional initialisation, sign-on message

?init:	ld	hl,8000h
	ld	(@civec),hl
	ld	(@covec),hl

	ld	hl,4000h
	ld	(@lovec),hl

	ld	hl,2000h
	ld	(@aivec),hl
	ld	(@aovec),hl

	ld	hl,signon
	call	?pmsg
	ret

; Get ccp for first time

?ldccp:	ld	a,1		; move ccp.com from 9000h (loaded
	call	?bank		; there by bootrom) to 100h in
	ld	hl,9000h	; bank 1
	ld	de,0100h
	ld	bc,3200
	ldir

	ld	a,2		; also put a copy in bank 2
	call	?bank
	ld	hl,9000h
	ld	de,0100h
	ld	bc,3200
	ldir

	ld	a,(@cbnk)
	call	?bank
	ret

; Reload ccp

?rlccp:	ld	hl,0100h	; get the copy of ccp from bank 2
	ld	bc,3840
rlccp1:	ld	a,2
	call	?bnksel
	ld	a,(hl)
	push	af
	ld	a,1
	call	?bnksel
	pop	af
	ld	(hl),a
	inc	hl
	dec	bc
	ld	a,b
	or	c
	jr	nz,rlccp1
	ret

; Signal time and date operation

?time:	ret

; Sign-on message

signon:

; Copyright message required if using Digital Research's CP/M3 BDOS

	db	'CP/M Version 3.0',cr,lf
	db	'Copyright 1984 by Digital Research',cr,lf,lf

	db	'CBIOS  '
	db	'0'+day / 10,'0'+day mod 10,'/'
	db	'0'+mon / 10,'0'+mon mod 10,'/'
	db	'0'+year /10,'0'+year mod 10
	db	cr,lf,lf
	 if	amp4
	db	'Drive G: Ampro 48TPI DSDD',cr,lf
	 endif
	 if	kay4
	db	'      H: Kaypro 4/10 DSDD',cr,lf
	 endif
	db	0

; Set source and destination banks for one operation

?xmove:	ret

; Block move memory to memory

?move:	ex	de,hl
	ldir
	ex	de,hl
	ret

; Select bank	a = bank (0,1 or 2)

?bank:	push	af
	push	bc
	push	hl
	add	a,a
	ld	c,a
	ld	b,0
	ld	hl,bnktbl
	add	hl,bc
	ld	c,(hl)
	in	a,(c)
	inc	hl
	ld	c,(hl)
	in	a,(c)
	pop	hl
	pop	bc
	pop	af
	ret

bnktbl:	db	1,2		; Bank 0 select ports
	db	0,3		; Bank 1
	db	1,3		; Bank 2
;
; Initialise physical devices - CRT/KB, LPT, SIO0, SIO1
;
?cinit:	ld	a,c
	cp	0
	jr	z,cini1		; crt/kbd
	cp	1
	jr	z,cini2		; lpt
	cp	2
	jr	z,cini3		; sio0
	cp	3
	jr	z,cini4		; sio1
	ret

; Initialise screen/keyboard

cini1:	call	clscrn		; clear screen, home cursor
	ld	a,9		; caps-lock flag off
	ld	(caps),a
	ld	c,a		; caps-lock led off
	out	(c),a
	ret

; Initialise printer

cini2:	ret

; Initialise serial port A

cini3:	ld	a,(dev2+7)	; default baudrate serial port A
	add	a,a
	ld	l,a
	ld	h,0
	ld	de,baudtbl
	add	hl,de
	ld	a,00110110b	; select counter 0, mode 3 binary
	out	(timercr),a	; load 2 bytes
	ld	a,(hl)
	out	(timer0),a
	inc	hl
	ld	a,(hl)
	out	(timer0),a
	ret

; Initialise serial port B

cini4:	ld	a,(dev3+7)	; default baudrate serial port B
	add	a,a
	ld	l,a
	ld	h,0
	ld	de,baudtbl
	add	hl,de
	ld	a,01110110b	; select counter 1, mode 3 binary
	out	(timercr),a	; load 2 bytes
	ld	a,(hl)
	out	(timer1),a
	inc	hl
	ld	a,(hl)
	out	(timer1),a
	ret

; baud rate divisor tables

baudtbl:
	dw	0180h		; default

	dw	0900h		; 50
	dw	0600h		; 75
	dw	0417h		; 110
	dw	0359h		; 134.5
	dw	0300h		; 150
	dw	0180h		; 300
	dw	00c0h		; 600
	dw	0060h		; 1200
	dw	0040h		; 1800
	dw	0030h		; 2400
	dw	0020h		; 3600
	dw	0018h		; 4800
	dw	0010h		; 7200
	dw	000ch		; 9600
	dw	0006h		; 19200
;
; Get status of physical input device
;
?cist:	ld	a,b
	cp	0
	jr	z,kbst		; kbd
	cp	1
	jr	z,?cist1	; lpt
	cp	2
	jr	z,?cist4	; sio0
	cp	3
	jr	z,?cist6	; sio1

				; else error
; Input status - printer

?cist1:	xor	a
	ret

; Input status - keyboard

kbst:	ld	a,(ccount)	; function key string waiting?
	or	a
	jr	nz,kbst1
	ld	a,(char)	; single character waiting?
	cp	0ffh
	jr	nz,kbst1
	in	a,(pcrb)	; strobe from keyboard?
	and	10000000b
	ret	z
	call	read$kbd	; read key
	ld	(char),a
	ld	a,(ccount)
	or	a
	ret	z

kbst1:	ld	a,0ffh		; character available
	ret

; Input status - serial port A

?cist4:	in	a,(siocra)
?cist5:	and	00000001b
	ret	z
	ld	a,0ffh
	ret

; Input status - serial port B

?cist6:	in	a,(siocrb)
	jr	?cist5

;
; Get status of physical output device
;

?cost:	ld	a,b
	or	a
	jr	z,?cost3	; crt
	cp	1
	jr	z,?cost2	; lpt
	cp	2
	jr	z,?cost4	; sio0
	cp	3
	jr	z,?cost6	; sio1

?cost1:	xor	a		; else error
	ret

; Output status - printer

?cost2:	in	a,(pddra)	; read PIA port A
	rra
	jr	nc,?cost1	; test printer busy PA0

; Output status - screen

?cost3:	ld	a,0ffh
	ret

; Output status - serial port A

?cost4:	in	a,(siocra)
?cost5:	and	00000100b
	ret	z
	ld	a,0ffh
	ret

; Output status - serial port B

?cost6:	in	a,(siocrb)
	jr	?cost5
;
; Input character from physical device
;
?ci:	ld	a,b
	or	a
	jr	z,?ci6		; kbd
	cp	1
	jr	z,?ci1		; lpt
	cp	2
	jr	z,?ci2		; sio0
	cp	3
	jr	z,?ci5		; sio1

				; else end-of-file
; Input character - printer

?ci1:	ld	a,1ah
	ret

; Input character - serial port a

?ci2:	ld	c,siocra
	ld	hl,maska	; get number of bits and parity
?ci3:	in	a,(c)
	and	00000001b
	jr	z,?ci3

	ld	a,(hl)
	and	00110000b
	srl	a
	srl	a
	srl	a
	srl	a
	ld	e,a
	ld	d,0
	ld	hl,?ci4
	add	hl,de
	ld	b,(hl)
	dec	c		; select data register
	in	a,(c)
	and	b
	ret

?ci4:	db	00011111b	; 5 bits
	db	00111111b	; 6
	db	01111111b	; 7
	db	11111111b	; 8

; Input character - serial port B

?ci5:	ld	c,siocrb
	ld	hl,maskb
	jr	?ci3

; Input character - keyboard

?ci6:	ld	a,(ccount)	; function key string waiting?
	or	a
	jr	z,?ci8

	dec	a		; if true, decrement count
	ld	(ccount),a
	ld	hl,(nxtchr)	; pointer to character
	ld	b,(hl)
	inc	hl
	ld	(nxtchr),hl	; increment pointer, test next char
	ld	a,(hl)		; if 0 then all done
	or	a
	jr	nz,?ci7
	xor	a		; clear count
	ld	(ccount),a
?ci7:	ld	a,b
	ret

?ci8:	ld	a,(char)	; single character waiting?
	cp	0ffh
	jr	z,wait$key
	ld	hl,char
	ld	(hl),0ffh
	ret

; no characters available, wait for input from keyboard

wait$key:
	in	a,(pcrb)	; wait for cb1 (keyboard strobe)
	sla	a
	jr	nc,wait$key

	call	read$kbd
	cp	0ffh
	jr	z,?ci6		; loop until character or keystring
	ret			; returned

;
; Read serial data from keyboard  (9 bit code)
;

read$kbd:
	ld	de,kbd$mode$tbl	; keyboard bit decode table
	ld	hl,0000
	ld	c,0
	ld	b,9

kbd$loop:
	in	a,(pddra)	; read pia port A
	sla	a
	jp	p,zerobit	; test PA6 (serial in) for 0 or 1

				; bit = 1
	ld	a,(de)
	inc	de
	add	a,c
	ld	c,a		; value of mode in C
	ld	a,(de)
	add	a,l
	ld	l,a		; value of key in L
	dec	de

zerobit:			; bit = 0
	inc	de
	inc	de

; clock in next bit

	ld	a,00110100b
	out	(pcrb),a	; set keyboard shift clock CB2 low
	ld	a,00111100b
	out	(pcrb),a	; set CB2 high
	djnz	kbd$loop	; get all 9 bits

	ld	a,c
	cp	3		; shift-control?
	jp	z,shift$ctrl

	cp	1		; shift?
	jr	nz,not$shift

	ld	de,90		; shifted keys, access second table
	add	hl,de

not$shift:
	ld	de,keytbl
	add	hl,de
	ld	a,(hl)		; get character from decode table
	cp	0ffh
	jr	z,no$key
	ld	b,a

; check for control key

	ld	a,c
	cp	2		; control key?
	jr	nz,?func

	ld	a,b
	cp	64		; key in-range?
	jr	c,no$key
	cp	127+1
	jr	nc,no$key

	cp	96		; convert to uppercase?
	jr	c,do$ctl
	sub	32
do$ctl:	sub	64		; make ascii code
	ld	b,a

; check for function key  (80-8f)

?func:	ld	a,b
	and	11110000b
	cp	10000000b
	jr	nz,?caps

; function key pressed, set up pointer to string

	ld	a,b
	sla	a		; *2
	sla	a		; *4
	sla	a		; *8
	sla	a		; *16
	ld	l,a
	ld	h,0
	ld	de,fntbl	; function key table
	add	hl,de
	ld	(nxtchr),hl	; set pointer
	ld	a,(hl)		; get first character
	or	a		; was it zero?
	jr	z,no$key
	ld	a,16		; no, then set max string count
	ld	(ccount),a
	jr	no$key

; check for caps-lock key

?caps:	ld	a,b
	cp	0cah		; caps-lock key?
	jr	nz,test$case

	ld	a,(caps)	; yes, toggle flag
	xor	1
	ld	(caps),a
	ld	c,a		; toggle led
	out	(c),a
	jr	no$key		; and exit

; convert key to upper/lower case according to caps flag

test$case:
	ld	hl,caps		; test flag
	bit	0,(hl)
	jr	nz,kbd$exit

	cp	'a'		; convert lowercase to upper
	jr	c,locase
	cp	'z'+1
	jr	nc,kbd$exit
	sub	32
	jr	kbd$exit

locase:
	 if	lcase
	cp	'A'		; convert uppercase to lower
	jr	c,kbd$exit
	cp	'Z'+1
	jr	nc,kbd$exit
	add	a,32
	 endif

kbd$exit:
	ld	b,a
	in	a,(pddrb)	; clear bits 6,7
	ld	a,b
	ret

no$key:	ld	a,0ffh		; no key
	jr	kbd$exit

; shift-control keys - not handled in original BIOS

shift$ctrl:
	ld	a,l
	cp	44
	ld	a,28		; shift-ctrl \
	jr	z,kbd$exit
	ld	a,l
	cp	81
	ld	a,31		; shift-ctrl _
	jr	z,kbd$exit
	jr	no$key

;
; Keyboard data decode table
;
;	bits 1,8	mode (normal, shift, control, shift-ctrl)
;	bits 2-7,9	which key in a 10*9 matrix was pressed
;

kbd$mode$tbl:
	db	1,0		; 1  B3
	db	0,8		; 2  B6
	db	0,2		; 3  B0
	db	0,1		; 4  B9
	db	0,4		; 5  B7
	db	0,16		; 6  B5
	db	0,32		; 7  B4
	db	2,0		; 8  B2
	db	0,64		; 9  B1
;
; Output character to physical device
;
?co:	ld	a,b
	or	a
	jr	z,co6		; crt
	cp	1
	jr	z,co4		; lpt
	cp	2
	jr	z,co1		; sio0
	cp	3
	jr	z,co3		; sio1
	ret

; Output character - serial port A

co1:	ld	b,c
	ld	c,siocra
co2:	in	a,(c)
	and	00000100b
	jr	z,co2
	ld	a,b
	dec c
	out	(c),a
	ret

; Output character - serial port B

co3:	ld	b,c
	ld	c,siocrb
	jr	co2

; Output character - printer

co4:	ld	a,c		; output byte to port
	out	(pddrb),a
co5:	call	?cost2		; wait until printer is ready
	or	a
	jr	z,co5

	nop			; then toggle strobe line
	nop
	nop
	ld	a,00110110b	; set CA2 low
	out	(pcra),a
	nop
	nop
	nop
	ld	a,00111110b	; set CA2 high
	out	(pcra),a
	ret

; Output character - screen

co6:	ld	a,(esc)		; escape mode?
	or	a
	jp	nz,do$esc

	ld	a,(graf)	; graphic mode?
	or	a
	jr	nz,do$graph

	ld	a,c		; character in C
	cp	cr		; carriage return?
	jp	z,creturn
	cp	lf		; linefeed?
	jr	z,lfeed
	cp	8		; backspace?
	jp	z,bspace
	cp	9		; horizontal tab?
	jp	z,htab
	cp	1ah		; clear screen
	jp	z,clscrn
	cp	18h		; clear end-of-line?
	jp	z,cleol
	cp	17h		; clear end-of-screen?
	jp	z,cleos
	cp	0ch		; advance cursor?
	jp	z,advcur
	cp	1eh		; home cursor?
	jp	z,homcur
	cp	1bh		; escape key?
	jp	z,esc$mode
	cp	0bh		; vertical tab?
	jp	z,vtab
	cp	7		; bell?
	jr	nz,vduout	; no, character is ok to print

; Bell

beep:	ld	c,0
beep1:	ld	a,64		; 1/4 volume
	out	(audio),a
	ld	b,40
beep2:	djnz	beep2
	xor	a		; volume off
	out	(audio),a
	ld	b,40
beep3:	djnz	beep3
	dec	c
	jr	nz,beep1
	ret

; Graphic mode

set$graph:
	ld	a,1		; start graphic display
	jr	do$graph1
do$graph:
	ld	a,c		; if null then end graphic mode
	cp	0
	jr	nz,vduout
	xor	a
do$graph1:
	ld	(graf),a	; set graphic flag
	ret

; Print character to screen

vduout:	and	01111111b	; strip hi bit ?
	ld	a,(rvsflg)
	or	c		; mask with inverse flag
	call	getpos		; get current screen position (hl)
	ld	(hl),a		; and poke character

; Advance cursor

advcur:	ld	a,(col)		; last column?
	cp	cols-1
	jr	z,advcur1	; then crlf
	inc	a		; else increment column
	ld	(col),a
	jr	posit		; move it
advcur1:
	xor	a
	ld	(col),a

; Line-feed

lfeed:	ld	a,(row)		; line before last?
	cp	rows-1
	jr	z,scroll
	inc	a		; increment line
	ld	(row),a
	jr	posit

; Scroll screen

scroll:	ld	hl,screen+cols	; move lower lines up one
	ld	de,screen
	ld	bc,cols*(rows-1)
	ldir
	ld	b,cols		; clear bottom line
	ld	hl,screen+cols*(rows-1)
	xor	a
scroll1:
	ld	(hl),a
	inc	hl
	djnz	scroll1

; Position cursor, address in HL

posit:	call	getpos
	ld	a,14		; crsr position lo register
	out	(crtcr),a
	ld	a,h
	and	00000111b
	out	(crtdr),a
	ld	a,15		; crsr position hi register
	out	(crtcr),a
	ld	a,l
	out	(crtdr),a
	ret

; Carriage return

creturn:
	xor	a
	ld	(col),a
	jr	posit

; Backspace

bspace:	ld	a,(col)
	dec	a
	jp	p,bspace1
	ld	a,(row)
	or	a
	ret	z
	dec	a
	ld	(row),a
	ld	a,cols-1
bspace1:
	ld	(col),a
	jr	posit

; Horizontal tab

htab:	call	advcur
	ld	a,(col)
	and	00000111b	; until 8th column
	jr	nz,htab
	ret

; Clear to end of screen

cleos:	call	getpos
cleos1:	ld	(hl),0		; should have been a 'space' but
	inc	hl		; left same as original BIOS
	ld	a,h
	or	l
	jr	nz,cleos1
	ret

; Clear screen, home cursor

clscrn:	ld	hl,screen
	call	cleos1

; Home cursor

homcur:	xor	a
	ld	(col),a
	ld	(row),a
	jr	posit

; Clear to end of line

cleol:	call	getpos
	ld	a,(col)
cleol1:	ld	(hl),0		; see note for clear screen
	inc	hl
	inc	a
	cp	cols
	jr	nz,cleol1
	ret

; Vertical tab

vtab:	ld	a,(row)		; move cursor up one line
	or	a
	ret	z
	dec	a
	ld	(row),a
	jr	posit

; Set escape mode

esc$mode:
	ld	a,3		; set esc count
	ld	(esc),a
	ret

; Escape codes

do$esc:	ld	a,(esc)		; decrement count
	dec	a
	ld	(esc),a
	cp	2		; previous key esc?
	jr	nz,do$esc2

	ld	a,c
	cp	'='		; cursor addressing command?
	ret	z

	xor	a		; clear escape flag
	ld	(esc),a
	ld	a,c		; get character, strip bit 7
	and	01111111b

	cp	'*'		; esc *  clear screen, home cursor
	jp	z,clscrn
	cp	'Y'		; esc Y  clear to end of screen
	jp	z,cleos
	cp	'T'		; esc T  clear to end of line
	jp	z,cleol
	cp	'R'		; esc R  delete line
	jr	z,delline
	cp	'E'		; esc E  insert line
	jr	z,insline
	cp	0ch		; esc ^L clear screen
	jp	z,clscrn
	cp	'G'		; esc G  start graphic display
	jp	z,set$graph

; Inverse mode

	ld	hl,rvsflg
	cp	'I'		; esc I  start inverse display
	jr	nz,do$esc1
	ld	(hl),128
do$esc1:
	cp	'N'		; esc N  end inverse display
	ret	nz
	ld	(hl),0
	ret

; Set cursor positioning from 'esc = yx' command

do$esc2:
	or	a		; got both arguments?
	jr	z,do$esc3
	ld	a,c		; save y argument
	ld	(yarg),a
	ret			; return for x

do$esc3:
	ld	a,c		; subtract 32 from x
	sub	32
	ld	(col),a
	ld	a,(yarg)
	sub	32		; subtract 32 from y
	ld	(row),a
	jp	posit
;
; Esc L  -  delete line
;
delline:
	xor	a
	ld	(col),a
	ld	a,(row)
	cp	rows-1
	jr	z,insline1
	call	getpos
	push	hl
	ld	de,cols
	add	hl,de
	ex	de,hl
	ld	hl,screen+cols*rows
	or	a
	sbc	hl,de
	ld	b,h
	ld	c,l
	pop	hl
	ex	de,hl
	ldir
	xor	a
	ld	hl,screen+cols*(rows-1)
	call	cleol1
	jp	posit
;
; Esc E  -  insert line
;
insline:
	xor	a
	ld	(col),a
	ld	a,(row)
	cp	rows-1
	jr	z,insline1
	call	getpos
	push	hl
	ld	hl,screen+cols*(rows-1)
	pop	bc
	or	a
	sbc	hl,bc
	ld	b,h
	ld	c,l
	ld	hl,screen+cols*(rows-1)-1
	ld	de,screen+cols*rows-1
	lddr
insline1:
	call	cleol
	jp	posit
;
; Get current screen position, hl returns address
;
getpos:	ld	hl,(row)	; get current line
	add	hl,hl		; *2
	add	hl,hl		; *4
	add	hl,hl		; *8
	add	hl,hl		; *16
	ld	d,h
	ld	e,l
	add	hl,hl		; *32
	add	hl,hl		; *64
	add	hl,de
	ld	de,(col)	; get current column
	add	hl,de
	ld	de,screen
	add	hl,de
	ret
;
; Get address of function key table HL
;
?fnkeys:
	ld	hl,fntbl
	ret

; Misc variables

ccount:	db	0		; # characters remaining in string
nxtchr:	dw	0		; pointer to next character in string
caps:	db	9		; caps-lock flag  8=on, 9=off
esc:	db	0		; esc mode  0=off
yarg:	db	0		; Y argument of 'esc = yx'
row:	dw	0		; current line
col:	dw	0		; current column
graf:	db	0		; graphic mode	0=off, 1=on
char:	db	0ffh		; single keyboard character
rvsflg:	db	0		; inverse mask	0=normal, 128=inverse

; Keyboard matrix - ascii decode tables

keytbl:	db	37h,38h,39h,30h,31h,32h,33h,34h,35h,36h
	db	75h,69h,6fh,70h,71h,77h,65h,72h,74h,79h
	db	8eh,8fh,0dh,2eh,20h,0cah,8ah,8bh,8ch,8dh
	db	86h,87h,88h,89h,80h,81h,82h,83h,84h,85h
	db	13h,04h,33h,08h,40h,0ffh,2dh,5dh,05h,18h
	db	39h,18h,32h,0ah,7fh,09h,5eh,5bh,37h,38h
	db	6dh,2ch,2eh,2fh,7ah,78h,63h,76h,62h,6eh
	db	6ah,6bh,6ch,3bh,61h,73h,64h,66h,67h,68h
	db	36h,2dh,31h,30h,1bh,0ffh,3ah,0dh,34h,35h

	db	27h,28h,29h,7ch,21h,22h,23h,24h,25h,26h
	db	55h,49h,4fh,50h,51h,57h,45h,52h,54h,59h
	db	8eh,8fh,0dh,2eh,20h,0cah,8ah,8bh,8ch,8dh
	db	86h,87h,88h,89h,80h,81h,82h,83h,84h,85h
	db	13h,04h,33h,08h,5ch,0ffh,3dh,7dh,05h,18h
	db	39h,60h,32h,0ah,7fh,09h,7eh,7bh,37h,38h
	db	4dh,3ch,3eh,3fh,5ah,58h,43h,56h,42h,4eh
	db	4ah,4bh,4ch,2bh,41h,53h,44h,46h,47h,48h
	db	36h,5fh,31h,30h,1bh,0ffh,2ah,0dh,34h,35h

; Strings assigned to the 16 function keys

fntbl:	db	'DIR ',0,0,0,0,0,0,0,0,0,0,0,0
	db	'ERASE ',0,0,0,0,0,0,0,0,0,0
	db	'RENAME ',0,0,0,0,0,0,0,0,0
	db	'TYPE ',0,0,0,0,0,0,0,0,0,0,0
	db	'DATE ',0,0,0,0,0,0,0,0,0,0,0
	db	'DEVICE ',0,0,0,0,0,0,0,0,0
	db	'ED ',0,0,0,0,0,0,0,0,0,0,0,0,0
	db	'GET ',0,0,0,0,0,0,0,0,0,0,0,0
	db	'HELP ',0,0,0,0,0,0,0,0,0,0,0
	db	'PIP ',0,0,0,0,0,0,0,0,0,0,0,0
	db	'PUT ',0,0,0,0,0,0,0,0,0,0,0,0
	db	'SET ',0,0,0,0,0,0,0,0,0,0,0,0
	db	'SETDEF ',0,0,0,0,0,0,0,0,0
	db	'SHOW ',0,0,0,0,0,0,0,0,0,0,0
	db	'SUBMIT ',0,0,0,0,0,0,0,0,0
	db	'SETUP ',0,0,0,0,0,0,0,0,0,0

; Serial port parameters - must follow fn key strings (used by SETUP)

maska:	db	00100100b	; 7 bits, even parity
maskb:	db	00100100b

; Device definition table

mbin	equ	00000001b	; input
mbout	equ	00000010b	; output
mbsb	equ	00000100b	; software selectable baudrate
mbser	equ	00001000b	; serial
mbx	equ	00010000b	; xon-xoff

; Baudrate

bnone	equ	0
b50	equ	1
b75	equ	2
b110	equ	3
b134	equ	4
b150	equ	5
b300	equ	6
b600	equ	7
b1200	equ	8
b1800	equ	9
b2400	equ	10
b3600	equ	11
b4800	equ	12
b7200	equ	13
b9600	equ	14
b19200	equ	15

@ctbl:

dev0:	db	'CRT/KB',mbin+mbout,bnone
dev1:	db	'LPT   ',mbout,bnone
dev2:	db	'SIO0  ',mbin+mbout+mbsb,b300
dev3:	db	'SIO1  ',mbin+mbout+mbsb,b300
	db	0

; Disk definition table		logical drive

@dtbl:	dw	xdph$a		; Bondwell 14
	dw	xdph$b		; Bondwell 14
	 if	bw12
	dw	xdph$c		; Bondwell 12
	 else
	dw	0
	 endif
	 if	sv3
	dw	xdph$d		; Spectravideo
	 else
	dw	0
	 endif
	 if	kay2
	dw	xdph$e		; Kaypro II
	 else
	dw	0
	 endif
	 if	osb1
	dw	xdph$f		; Osborne I
	 else
	dw	0
	 endif
	 if	amp4
	dw	xdph$g		; Ampro DSDD 48 tpi
	 else
	dw	0
	 endif
	 if	kay4
	dw	xdph$h		; Kaypro 4/10
	 else
	dw	0
	 endif

	dw	0,0,0,0,0,0,0,0	; I-P unused drives

; Extended disk parameter headers, one for each logical drive.
; CSV, ALV, DIRBCB, DTABCB, HASH for each xdph are automatically
; allocated by GENCPM.

csv	equ	0fffeh
alv	equ	0fffeh
dirbcb	equ	0fffeh
dtabcb	equ	0fffeh
hash	equ	0fffeh

dr0	equ	0			; physical drive 0
dr1	equ	1			; physical drive 1

; Drive A	Bondwell 14

	dw	wr256			; write
	dw	rd256			; read
	dw	dvlog			; login
	dw	dvinit			; init
	db	dr0,0			; physical drive
xdph$a:	dw	0			; xlt
	db	0,0,0,0,0,0,0,0,0,0
	dw	dpb1			; dpb
	dw	csv			; csv
	dw	alv			; alv
	dw	dirbcb			; dirbcb
	dw	dtabcb			; dtabcb
	dw	hash			; hash
	db	0			; hbank

; Drive B	Bondwell 14

	dw	wr256
	dw	rd256
	dw	dvlog
	dw	dvinit
	db	dr1,0
xdph$b:	dw	0
	db	0,0,0,0,0,0,0,0,0,0
	dw	dpb1
	dw	csv
	dw	alv
	dw	dirbcb
	dw	dtabcb
	dw	hash
	db	0

; Drive C	Bondwell 12

	 if	bw12
	dw	wr256
	dw	rd256
	dw	dvlog
	dw	dvinit
	db	dr1,0
xdph$c:	dw	0
	db	0,0,0,0,0,0,0,0,0,0
	dw	dpb2
	dw	csv
	dw	alv
	dw	dirbcb
	dw	dtabcb
	dw	hash
	db	0
	 endif

; Drive D	Spectravideo 318/328

	 if	sv3
	dw	wr256
	dw	rd256
	dw	dvlog
	dw	dvinit
	db	dr1,0
xdph$d:	dw	xlt2
	db	0,0,0,0,0,0,0,0,0,0
	dw	dpb3
	dw	csv
	dw	alv
	dw	dirbcb
	dw	dtabcb
	dw	hash
	db	0
	 endif

; Drive E	Kaypro II

	 if	kay2
	dw	wr512
	dw	rd512
	dw	dvlog
	dw	dvinit
	db	dr1,0
xdph$e:	dw	0
	db	0,0,0,0,0,0,0,0,0,0
	dw	dpb4
	dw	csv
	dw	alv
	dw	dirbcb
	dw	dtabcb
	dw	hash
	db	0
	 endif

; Drive F	Osborne I

	 if	osb1
	dw	wr1024
	dw	rd1024
	dw	dvlog
	dw	dvinit
	db	dr1,0
xdph$f:	dw	xlt2
	db	0,0,0,0,0,0,0,0,0,0
	dw	dpb5
	dw	csv
	dw	alv
	dw	dirbcb
	dw	dtabcb
	dw	hash
	db	0
	 endif

; Drive G	Ampro DSDD 48tpi

	 if	amp4
	dw	wr512
	dw	rd512
	dw	dvlog
	dw	dvinit
	db	dr1,0
xdph$g:	dw	xlt3
	db	0,0,0,0,0,0,0,0,0,0
	dw	dpb6
	dw	csv
	dw	alv
	dw	dirbcb
	dw	dtabcb
	dw	hash
	db	0
	 endif

; Drive H	Kaypro 4/10 DSDD

	 if	kay4
	dw	wr512
	dw	rd512
	dw	dvlog
	dw	dvinit
	db	dr1,0
xdph$h:	dw	xlt1
	db	0,0,0,0,0,0,0,0,0,0
	dw	dpb7
	dw	csv
	dw	alv
	dw	dirbcb
	dw	dtabcb
	dw	hash
	db	0
	 endif

; Disk parameter blocks for each disk format

				; Bondwell 14
dpb1:	dw	36		; SPT	36 logical sectors per track
	db	4		; BSH	2k block size
	db	15		; BLM
	db	1		; EXM
	dw	174		; DSM	175 blocks
	dw	127		; DRM	128 directory entries
	db	192		; AL0	2 directory blocks
	db	0		; AL1
	dw	32		; CKS
	dw	2		; OFF	2 reserved tracks
	db	1		; PSH
	db	1		; PHM	2 logical per physical sectors

	 if	bw12
dpb2:	dw	36		; Bondwell 12
	db	4
	db	15
	db	1
	dw	84
	dw	127
	db	192
	db	0
	dw	32
	dw	2
	db	1
	db	1
	 endif

	 if	sv3
dpb3:	dw	34		; Spectravideo SV318/328
	db	3
	db	7
	db	0
	dw	156
	dw	63
	db	192
	db	0
	dw	16
	dw	3
	db	1
	db	1
	 endif

	 if	kay2
dpb4:	dw	40		; Kaypro II
	db	3
	db	7
	db	0
	dw	194
	dw	63
	db	240
	db	0
	dw	16
	dw	1
	db	2
	db	3
	 endif

	 if	osb1
dpb5:	dw	40		; Osborne 1
	db	3
	db	7
	db	0
	dw	184
	dw	63
	db	192
	db	0
	dw	16
	dw	3
	db	3
	db	7
	 endif

	 if	amp4
dpb6:	dw	40		; Ampro dsdd 48tpi
	db	4
	db	15
	db	1
	dw	194
	dw	127
	db	192
	db	0
	dw	32
	dw	2
	db	2
	db	3
	 endif

	 if	kay4
dpb7:	dw	40		; Kaypro 4/10
	db	4
	db	15
	db	1
	dw	196
	dw	63
	db	128
	db	0
	dw	16
	dw	1
	db	2
	db	3
	 endif

; Translate tables

xlt1:	db	0
xlt2:	db	1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16
xlt3:	db	17,18,19,20,21,22,23,24,25,26

;
;	Disk drive controller routines
;

; initialise drive

dvinit:

; login drive - determine disk parameters, load DPB

dvlog:	ret

; read/write - 256 byte sectors

rd256:	call	setrd
	jr	rw256

wr256:	call	setwrt

rw256:	ld	a,(@sect)	; sector
	ld	(putbuf+4),a
	ld	a,1		; 256 bytes
	ld	(putbuf+5),a
	ld	a,10		; gap length
	ld	(putbuf+7),a
	ld	a,1
	ld	(blocks),a
	jp	rwsec

; read/write - 512 byte sectors

rd512:	call	setrd
	jr	rw512

wr512:	call	setwrt

rw512:	ld	a,(@sect)

; sector modification for kaypro 4/10

	 if	kay4
	ld	b,a
	ld	a,(@adrv)
	cp	7		; drive H
	ld	a,b
	jr	nz,nosec
	ld	a,(@trk)
	srl	a
	ld	a,b
	jr	nc,nosec
				; odd tracks = side 1
	add	a,10		; change sector number
nosec:
	 endif

	ld	(putbuf+4),a
	ld	a,2		; 512 bytes
	ld	(putbuf+5),a
	ld	a,42		; gap length
	ld	(putbuf+7),a
	ld	a,2
	ld	(blocks),a
	jp	rwsec

; read/write - 1024 byte sectors

rd1024:	call	setrd
	jr	rw1024

wr1024:	call	setwrt

rw1024:	ld	a,(@sect)
	ld	(putbuf+4),a
	ld	a,3		; 1024 bytes
	ld	(putbuf+5),a
	ld	a,128		; gap length
	ld	(putbuf+7),a
	ld	a,4
	ld	(blocks),a
	jr	rwsec

; common sector read/write routine

rwsec:	ld	a,(@dbnk)	; set bank for i/o
	call	?bank
	ld	a,(hddrv)
	ld	(putbuf+1),a	; head/drive
	srl	a
	srl	a

; ignore side check for Kaypro 4/10

	 if	kay4
	ld	e,a
	ld	a,(@adrv)
	cp	7		; drive H
	ld	a,e
	jr	nz,chkok
	ld	a,0		; side ID always 0
chkok:
	 endif

	ld	(putbuf+3),a	; side ID
	ld	a,(track)
	ld	(putbuf+2),a	; track ID

	ld	a,maxtry	; maximum error retries
	ld	(dskerr),a

rwsec1:	ld	a,(blocks)	; # 256 byte blocks per physical sector
	ld	d,a
	ld	b,0
	ld	c,9		; send read/write command
	call	putfdc
	ld	hl,(@dma)

	call	waitint		; wait for request

; physical sector read or write

rwsec2:	jp	0000		; *** self-modifying code ***
				; jump to sector read / write

rd$byt:	in	a,(fdcdr)	; read a byte
	ld	(hl),a
	jr	rwsec3

wr$byt:	ld	a,(hl)		; write a byte
	out	(fdcdr),a

rwsec3:	inc	hl		; inc buffer pointer
	djnz	rwsec4
	dec	d		; done whole sector?
	jr	nz,rwsec4

	call	tc		; terminate command
	call	waitint
	ld	c,7		; get result from fdc
	call	getfdc
	ld	a,(getbuf)	; status st0
	and	11000000b
	jr	nz,rwsec5
	jr	rwsec7

rwsec4:	in	a,(pddra)	; wait for fdc to signal next data byte
	rla
	jr	c,rwsec2
	in	a,(pddra)
	rla
	jr	c,rwsec2
	in	a,(pddra)
	rla
	jr	c,rwsec2
	in	a,(pddra)
	rla
	jr	c,rwsec2
	in	a,(pddra)
	rla
	jr	c,rwsec2

	ld	c,6		; fdc error - timed-out
	call	getfdc
rwsec5:	ld	a,(dskerr)	; error, decrement count
	dec	a
	ld	(dskerr),a

	cp	maxtry/2	; try recalibration?
	jr	nz,rwsec6

	ld	hl,putbuf	; save current fdc command
	ld	de,tmpbuf
	ld	bc,9
	ldir
	call	drvcal		; recalibrate drive
	call	seek		; restore track
	ld	hl,tmpbuf
	ld	de,putbuf
	ld	bc,9
	ldir
	jp	rwsec1

rwsec6:	or	a		; err count reached zero?
	jp	nz,rwsec1

	 if	errors
	call	?pderr		; display track, sector error
	 endif

	ld	a,1
rwsec7:	push	af		; restore bank
	ld	a,(@cbnk)
	call	?bank
	in	a,(0ah)		; de-select both drives
	in	a,(0ch)
	pop	af
	ret

blocks:	db	0		; number of 256 byte blocks per sector
				; for read/write

dskerr:	db	0		; read/write error count

; Recalibrate drive

drvcal:	call	waitcmd
	call	drvstat		; get drive status
	ld	a,(getbuf)
	and	00100000b
	jr	z,drvcal	; wait till drive is ready
	call	waitcmd
	ld	hl,(@recal)	; 2 bytes
	ld	(putbuf),hl
	ld	a,(@rdrv)
	inc	a
	ld	(putbuf+1),a
	ld	c,2
	call	putfdc
	call	waitint
	call	sintfdc
	ld	a,(getbuf)
	and	11110000b
	cp	00100000b
	ret

; Turn drive on, seek track, set read/write command for FDC

setrd:	ld	hl,rd$byt
	ld	(rwsec2+1),hl
	call	drvon
	call	seek
	call	waitcmd
	ld	hl,@read
	jr	setrw1

setwrt:	ld	hl,wr$byt
	ld	(rwsec2+1),hl
	call	drvon
	call	drvstat
	ld	a,(getbuf)
	and	01000000b	; write protected?
	jr	z,setrw
	pop	hl
	ld	a,2
	jp	rwsec7		; abort

setrw:	call	seek
	call	waitcmd
	ld	hl,@write
setrw1:	ld	de,putbuf	; load fdc command buffer
	ld	bc,9
	ldir
	ret

; Turn drive on

drvon:	ld	a,(@rdrv)	; get current drive
	or	a
	jr	z,drvon1
	ld	b,0dh		; setup for drive B on
	ld	c,0ah		;	    drive A off
	jr	drvon2

drvon1:	ld	b,0bh		; setup for drive A on
	ld	c,0ch		;	    drive B off
drvon2:	in	a,(pddra)	; get motor status
	out	(c),a		; select current drive
	ld	c,b
	out	(c),a		; deselect other drive
	and	00001000b	; was drive already on?
	ret	nz		; then return
	ld	de,120		; else allow to reach speed (1000 mS)
	jp	vdelay

; Seek track

seek:	call	waitcmd
	ld	hl,@seek
	ld	de,putbuf
	ld	bc,3
	ldir
	ld	hl,@rdrv

	ld	a,(@adrv)

	 if	amp4
	cp	6		; G: Ampro 48tpi
	jr	z,seek2
	 endif

	 if	kay4
	cp	7		; H: Kaypro 4/10
	jr	z,seek2
	 endif

	ld	a,(@trk)	; convert logical to physical track
	cp	40		; over 39?
	jr	nc,seek1
	ld	(track),a	; no, head=0
	xor	a
	jr	seek3

seek1:	sub	40		; else head=1
	ld	(track),a
	ld	a,00000100b
	jr	seek3

seek2:	ld	a,(@trk)	; odd numbered tracks use head #1
	srl	a		; divide by 2
	ld	(track),a
	rla			; get overflow from carry
	and	00000001b
	jr	z,seek3
	sla	a		; set bit 2
	sla	a
seek3:	or	(hl)
	inc	a
	ld	(hddrv),a
	ld	(putbuf+1),a
	ld	a,(track)
	ld	(putbuf+2),a
	ld	c,3
	call	putfdc
	call	waitint
	call	sintfdc
	ld	a,(getbuf)
	and	00100000b	; seek completed?
	jr	z,seek
	ret

; Service FDC interrupt

sintfdc:
	call	waitcmd
	ld	a,(@sense)	; 1 byte
	ld	(putbuf),a
	ld	c,1
	call	putfdc
	ld	c,2
	call	getfdc
	ret

; Sense disk status

drvstat:
	call	waitcmd
	ld	hl,(@stat)	; 2 bytes
	ld	(putbuf),hl
	ld	a,(@rdrv)
	inc	a
	ld	(putbuf+1),a
	ld	c,2
	call	putfdc
	ld	c,1
	call	getfdc
	ret

; Put C bytes to FDC

putfdc:	ld	hl,putbuf
putfd1:	call	delay
	in	a,(fdcst)
	and	11000000b
	cp	10000000b
	jr	nz,putfd1

	ld	a,(hl)
	out	(fdcdr),a
	inc	hl
	dec	c
	jr	nz,putfd1
	ret

; Get C bytes from FDC

getfdc:	ld	hl,getbuf
getfd1:	call	delay
	in	a,(fdcst)
	and	11000000b
	cp	11000000b
	jr	nz,getfd1

	in	a,(fdcdr)
	ld	(hl),a
	inc	hl
	dec	c
	jr	nz,getfd1
	ret

; Variable delay  DE * 8.5 mS approx

vdelay:	ld	b,0
vdelay1:
	call	delay
	djnz	vdelay1
	dec	de
	ld	a,d
	or	e
	jr	nz,vdelay
	ret

; Set / reset TC input (terminate FDC command)

tc:	out	(0fh),a		; set TC high
	call	delay
	call	delay
	out	(0eh),a		; set TC low
	ret

; Wait until FDC is ready to accept a command

waitcmd:
	call	delay
	in	a,(fdcst)
	and	00110000b
	jr	nz,waitcmd
	ret

; Wait until FDC issues interrupt

waitint:
	nop
	in	a,(pddra)
	rla
	jr	nc,waitint
	ret

; Small delay  32uS (including CALL)

delay:	ex	(sp),ix
	ex	(sp),ix
	ex	(sp),ix
	ex	(sp),ix
	ret

; FDC commands

@seek:	db	0fh,1,0
@sense:	db	8
@read:	db	46h,1,0,0,1,1,12h,0ah,0ffh
@write:	db	45h,1,0,0,1,1,12h,0ah,0ffh
@stat:	db	4,1
@recal:	db	7,1

putbuf:	ds	9		; fdc send buffer
getbuf:	ds	7		; fdc get buffer
tmpbuf:	ds	9		; temp command buffer
hddrv:	ds	1		; head/drive
track:	ds	1		; physical track

	end