;++
;
; Floppy formatter for the TRS-80 Model II under CP/M.
;
; By John Wilson.
;
; Should be adaptable to other machines using WD 179X FDCs, and probably runs
; as-is on the Model 12.
;
; Includes support for 3.5"/5.25" disks, although making CP/M like them is your
; problem.
;
; Copyright (C) 1995 by John Wilson.  All rights reserved.  This program or
; extracts thereof may be freely distributed and/or modified, as long as proper
; credit is given to the author.
;
; 03/07/92	JMBW	Created.
; 01/31/95	JMBW	Prettified for release.
;
;--
bdos	equ	0005h
;
lf	equ	0Ah
cr	equ	0Dh
;
; Z-80 instructions that we use:
;
otir	equ	0B3EDh		;copy (HL) (len=B) to port C
;
	org	100h
start:	; start here
	lxi	sp,stack	;set up stack
	call	print
	db	'TRS-80 Model II disk formatter',cr,lf
	db	'By John Wilson',cr,lf,'$'
loop:	lxi	sp,stack	;reinit
	call	print		;display prompt
	db	'*$'
	xra	a		;load 0
	sta	kbbuf+1		;set # chars in buf
	mvi	a,lkbbuf	;length
	sta	kbbuf		;set max # chars
	lxi	d,kbbuf		;pt at buffer
	mvi	c,0Ah		;get string
	call	bdos
	mvi	e,lf		;echo lf
	mvi	c,2		;conout
	call	bdos
	lxi	h,kbbuf+1	;pt at length byte
	mov	e,m		;get length
	mvi	d,0
	dad	d		;pt at last char
	inx	h		;+1 to char after
	mvi	m,0		;mark end
	lxi	h,kbbuf+2	;pt at string
loop1:	lxi	d,cmdtab	;pt at commands
	call	keyw		;look up & dispatch
	jz	loop		;blank line, ignore
badkw:	; bad keyword, complain
	ldax	d		;get a char
	inx	d
	push	b		;save
	push	d
	mov	e,a		;copy
	mvi	c,2		;write
	call	bdos
	pop	d		;restore
	pop	b
	dcr	b		;done?
	jnz	badkw		;no
	call	print
	db	'?',cr,lf,'$'
	jmp	loop
next:	; handle next command on line
	mov	a,m		;get next char (they called CONFRM)
	cpi	','		;more?
	jnz	loop		;no
	inx	h		;yes, skip it
	jmp	loop1		;look up
;
cmdtab:	db	3,6,'1.44MB'	;set for standard 3.5" 1.44MB disk
	dw	def144
	db	1,6,'2.88MB'	;set for standard (?) 3.5" 2.88MB disk
	dw	def288
	db	1,5,'360KB'	;set for standard 5.25" 360KB disk
	dw	def360
	db	1,5,'720KB'	;set for standard 3.5/5.25" 720KB disk
	dw	def720
	db	2,3,'8DD'	;8" double density
	dw	def8dd
	db	2,3,'8SD'	;8" single density
	dw	def8sd
	db	2,3,'8XD'	;8" extended density
	dw	def8xd
	db	2,2,'A:'	;unit 0
	dw	unit0
	db	2,3,'B/S'	;bytes per sector
	dw	bytes
	db	2,2,'B:'	;unit 1
	dw	unit1
	db	2,85h,'BYTES'	;# of bytes per sector
	dw	bytes
	db	2,2,'C:'	;unit 2
	dw	unit2
	db	2,89h,'CYLINDERS' ;synonym for TRACKS (well not really)
	dw	trks
	db	2,2,'D:'	;unit 3
	dw	unit3
	db	2,2,'DD'	;double density
	dw	dd
	db	2,2,'DS'	;double sided
	dw	ds1
	db	1,3,'FDC'	;set FDC base address (E0 or A0, or ?)
	dw	fdc
	db	4,4,'FDC1'	;use FDC #1
	dw	fdc1
	db	4,4,'FDC2'	;use FDC #2
	dw	fdc2
	db	1,2,'GO'	;actually format
	dw	go
	db	1,4,'QUIT'	;quit to CP/M
	dw	0
	db	2,4,'RATE'	;set bit rate
	dw	rate
	db	2,3,'RPM'	;let us know drive speed
	dw	motrpm
	db	2,2,'SD'	;single density
	dw	sd
	db	2,7,'SECTORS'	;# of sectors
	dw	sectrs
	db	1,4,'SHOW'	;show parameters
	dw	show
	db	2,2,'SS'	;single sided
	dw	ss
	db	6,6,'TRACK0'	;track 0 SD or like rest of disk
	dw	trk0
	db	1,6,'TRACKS'	;# of tracks (actually cylinders)
	dw	trks
	dw	0
;+
;
; Set parameters for 1.44 MB 3.5" ufloppy.
;
;-
def144:	call	confrm		;check tail for junk
	mvi	a,2		;# sides
	sta	sides
	lda	select		;get select reg value
	ani	0Fh		;don't mess with drive
	ori	0C0h		;DD, side 0, 500kHz clock
	sta	select
	mvi	a,80		;# tracks
	sta	tracks
	mvi	a,18		;# sectors
	sta	secs
	mvi	a,2		;512 b/s
	sta	size
	mvi	a,1		;300 RPM
	sta	rpm
	xra	a		;track 0 same
	sta	trk0sd
	jmp	next
;+
;
; Set parameters for 2.88MB 3.5" ufloppy.  Well worth a try anyway.
;
;-
def288:	call	confrm		;confirmed?
	mvi	a,2		;DS
	sta	sides
	lda	select		;get select reg value
	ani	0Fh		;preserve drv sel
	ori	0E0h		;DD, side 0, 1MHz clock
	sta	select
	mvi	a,80		;# tracks
	sta	tracks
	mvi	a,36		;# sectors
	sta	secs
	mvi	a,2		;512 b/s
	sta	size
	mvi	a,1		;300 RPM
	sta	rpm
	xra	a		;track 0 same
	sta	trk0sd
	jmp	next
;+
;
; Set parameters for 5.25" 360KB minifloppy.
;
;-
def360:	call	confrm		;check tail for junk
	mvi	a,2		;# sides
	sta	sides
	lda	select		;get sel reg value
	ani	0Fh		;isolate drv sel
	ori	0D0h		;DD, side 0, 250kHz clock
	sta	select
	mvi	a,40		;# tracks
	sta	tracks
	mvi	a,9		;# sectors
	sta	secs
	mvi	a,2		;512 b/s
	sta	size
	mvi	a,1		;300 RPM
	sta	rpm
	xra	a		;track 0 same
	sta	trk0sd
	jmp	next
;+
;
; Set parameters for 720KB 3.5" or 5.25" mini/microfloppy.
;
;-
def720:	call	confrm		;check tail for junk
	mvi	a,2		;# sides
	sta	sides
	lda	select		;get select reg
	ani	0Fh		;save drv sel
	ori	0D0h		;DD, hd 0, 250kHz clock
	sta	select
	mvi	a,80		;# tracks
	sta	tracks
	mvi	a,9		;# sectors
	sta	secs
	mvi	a,2		;512 b/s
	sta	size
	mvi	a,1		;300 RPM
	sta	rpm
	xra	a		;track 0 same
	sta	trk0sd
	jmp	next
;+
;
; Set parms for 8" double density (26*256).
;
;-
def8dd:	call	confrm		;confirmed?
	lda	select		;get sel reg
	ani	0Fh		;save drv sel
	ori	0C0h		;DD, hd 0, 500kHz clock
	sta	select
	mvi	a,1		;256 b/s
	sta	size
sd8:	mvi	a,26		;# sectors
	sta	secs
xd8:	mvi	a,77		;# tracks
	sta	tracks
	xra	a		;360 RPM
	sta	rpm
	inr	a		;track 0 SD
	sta	trk0sd
	sta	sides		;1 side
	jmp	next
;+
;
; Set parms for 8" single density (26*128).
;
;-
def8sd:	call	confrm		;confirmed?
	lda	select		;get sel reg
	ani	0Fh		;save drv sel
	ori	40h		;SD, hd 0, 500kHz clock
	sta	select
	xra	a		;128 b/s
	sta	size
	jmp	sd8
;+
;
; Set parms for 8" extended density (8*1K).
;
;-
def8xd:	call	confrm		;confirmed
	lda	select		;get sel reg
	ani	0Fh		;save drv sel
	ori	0C0h		;DD, hd 0, 500kHz clock
	sta	select
	mvi	a,8		;8 sectors
	sta	secs
	mvi	a,3		;1024 b/s
	sta	size
	jmp	xd8
;+
;
; Set disk unit #'s.
;
;-
unit3:	add	a		;*8
unit2:	add	a		;*4
unit1:	add	a		;*2
unit0:	cma			;1's comp
	ani	0Fh		;isolate
	mov	b,a		;copy
	lda	select		;get select reg
	ani	0F0h		;isolate left half
	ora	b		;OR in new bits
	call	confrm		;check tail for junk
	sta	select
	jmp	next
;+
;
; Set number of bytes per sector.
;
;-
bytes:	lxi	d,bytes1	;list
	call	keyw		;look up keyword
	jmp	badkw		;bad keyword
bytes1:	db	2,3,'128'	;128 b/s
	dw	b128
	db	1,3,'256'	;256 b/s
	dw	b256
	db	1,3,'512'	;512 b/s
	dw	b512
	db	2,4,'1024'	;1024 b/s
	dw	b1024
	db	2,83h,'1KB'	;synonym for above
	dw	b1024
	dw	0
;
b1024:	inr	a		;4
b512:	inr	a		;3
b256:	inr	a		;2
b128:	dcr	a		;1; make 0-3
	call	confrm		;confirmed?
	sta	size		;save size flag
	jmp	next
;
dd:	; double density
	call	confrm		;confirmed?
	lda	select		;get sel reg
	ori	80h		;DD
	sta	select
	jmp	next
;
ds1:	; double sided
	call	confrm		;confirmed?
	mvi	a,2		;# sides
	sta	sides
	jmp	next
;+
;
; Set FDC base address (E0 or A0).
;
;-
fdc:	call	skip		;skip blanks
	jz	fdc1		;use default value
	call	hexin		;get hex #
	jz	fdcba1		;skip if help
	call	confrm		;confirmed?
	jmp	setprt
fdcba1:	call	print
	db	'Specify FDC base I/O address (default=E0)',cr,lf,'$'
	jmp	loop
;
fdc1:	; use FDC #1 (E0)
	call	confrm		;confirmed?
	mvi	a,0E0h		;base addr
	jmp	setprt		;set it
;
fdc2:	; use FDC #2 (A0)
	call	confrm		;confirmed?
	mvi	a,0A0h		;base addr
setprt:	; set port in A
	sta	port		;(E0) save
	sta	cmdE0+1		;patch
	adi	4		;(E4)
	sta	abrE4a+1	;patch
	sta	abrE4b+1
	sta	abrE4c+1
	sta	abrE4d+1
	sta	cmdE4a+1
	sta	cmdE4b+1
	adi	2		;(E6)
	sta	fcyE6+1		;patch
	inr	a		;(E7)
	sta	abrE7+1		;patch
	sta	seek2+1
	sta	rport		;fix DMA commands
	sta	wport
	adi	8		;(EF)
	sta	goEFa+1		;patch
	sta	goEFb+1
	sta	goEFc+1
	sta	goEFd+1
	sta	errEF+1
	sta	fcyEFa+1
	sta	fcyEFb+1
	jmp	next
;+
;
; Set data rate (for DD mode).
;
; Radio Shack controllers all run at 500kHz (250kHz SD).
;
; The Revised Disk Controller has a jumper to run at 250kHz for 5.25"
; minifloppies, and can be trivially modified to run at 1MHz for 2.88MB
; microfloppies (naturally it isn't that simple though, oh well now I know).
;
; I modified mine (by adding one 74LS74, one 74LS153, and one 74LS174 -- you
; figure out where) to be able to select these speeds from software using the
; two don't-care bits in the select register (port EF).  These bits are latched
; on a second 74LS174 piggybacked on the one on the board, then clocked using
; the 74LS74 to ensure that speed changes occur only at 250kHz transitions
; (don't want glitches), and fed to the 74LS153 to choose which clock is fed to
; FDCLK (which appears on jumper pin Q).  The 74LS153 inputs are wired to
; select the following speeds:
;  EF<5:4>	speed
;  00h		500kHz	normal
;  10h		250kHz	b4=minifloppy select bit
;  20h		1MHz	b5=2.88MB select bit (doesn't work though)
;  30h		500kHz	normal again (not used by this program)
;
; 00 and 30 are both set to give the "normal" speed, since these are the values
; most likely to be written by programs which think they're don't-cares (00
; makes sense, but the other bits in the register are active-low so 30 would be
; convenient too).
;
; ANYWAY, so the upshot is if your controller is modified like mine then this
; command will actually change the speed, and if not then it will inform the
; program what speed you have set the jumpers for, and then write meaningless
; values to the don't-care bits in the select register.  Big deal.
;
;-
rate:	lxi	d,rate1		;table
	call	keyw		;look up
	jmp	badkw
rate1:	db	1,4,'1MHZ'	;20h in select reg
	dw	r1m
	db	1,6,'250KHZ'	;10h in select reg
	dw	r250k
	db	1,6,'500KHZ'	;0 in select reg
	dw	r500k
	dw	0
;
r1m:	adi	10h		;a=21h
r250k:	adi	10h		;a=11h
r500k:	ani	30h		;0, 10h, or 20h
	call	confrm		;confirmed?
	mov	b,a		;save
	lda	select		;get select reg
	ani	0CFh		;lose speed bits
	ora	b		;OR in new ones
	sta	select		;save it
	jmp	next		;later
;+
;
; Set RPM of drive motor.
;
; Actually don't set it, but tell us what it is for the purpose of computing
; the number of bytes per track (=7.5*BPS/RPM), which we may do some day for
; checking cute formats.
;
; 8" drives and 1.2MB 5.25" HD drives use 360 RPM.
; SD/DD 5.25" and all 3.5" drives use 300 RPM.
;
; Some weird 5.25" HD drives have a speed-select line to slow them down to 300
; RPM for handling DD floppies, but I don't feel motivated to modify my FDC to
; handle this line since such drives are rare and besides DD disks written on
; HD drives are very unreliable (tracking/hub-centering probs).
;
; The more usual case for DD disks on HD drives is to use a bit rate of 300kHz.
; This FDC mod wouldn't be as trivial as the *2 and /2 ones, so why bother?
;
;-
motrpm:	lxi	d,motor1	;table
	call	keyw
	jmp	badkw
motor1:	db	2,3,'300'
	dw	rpm300
	db	2,3,'360'
	dw	rpm360
	dw	0
;
rpm360:	xra	a		;a=0
rpm300:	call	confrm		;a=1; confirmed?
	sta	rpm		;save
	jmp	next
;
sd:	; single density
	call	confrm		;confirmed?
	lda	select		;get sel reg
	ani	7Fh		;clear DD bit
	sta	select
	jmp	next
;+
;
; Set # of sectors/track.
;
;-
sectrs:	call	decin		;get decimal #
	jz	sectr1
	call	confrm		;confirmed?
	sta	secs		;set # sectors
	jmp	next
sectr1:	call	print
	db	'Specify number of sectors per track (decimal)',cr,lf,'$'
	jmp	loop
;+
;
; Show setup.
;
;-
show:	call	confrm		;confirmed?
	push	h		;save cmd ptr
	call	params		;show parameters
	pop	h		;restore
	jmp	next
;
params:	; logical unit no.
	lda	select		;get select reg
	mvi	b,'A'		;load drive letter
	rar			;right 1
	jnc	drive1
	inr	b		;B
	rar
	jnc	drive1
	inr	b		;C
	rar
	jnc	drive1
	inr	b		;D
drive1:	mov	a,b		;copy
	sta	drive2
	call	print
	db	'Formatting on drive '
drive2:	db	'X:$'
	; controller
	lda	port		;get port #
	cpi	0E0h		;standard addr?
	jz	ctl2		;yeah, don't say anything
	cpi	0A0h		;revised controller w/J-K jumper?
	jnz	ctl1		;no
	call	print
	db	' (FDC2)$'
	jmp	ctl2
ctl1:	; nonstandard address
	call	print		;hope it's a standard controller!
	db	' (FDC at $'
	lda	port		;get port #
	call	hex		;display it
	mvi	e,')'		;)
	mvi	c,2
	call	bdos
ctl2:	; # sides
	lda	sides		;# sides
	dcr	a		;1 or 2?
	jnz	sides1
	call	print		;1
	db	' SS$'
	jmp	sides2
sides1:	call	print		;2
	db	' DS$'
sides2:	; density
	lda	select		;get flags
	ora	a		;single?
	jm	dens1		;no
	call	print		;single density
	db	'SD $'
	jmp	dens2
dens1:	call	print		;double density
	db	'DD $'
dens2:	; # of tracks
	lda	tracks		;get #
	call	decout
	call	print
	db	' tracks, $'
	; # of sectors
	lda	secs		;get #
	call	decout
	call	print
	db	' sectors, $'
	; sector size
	lda	size		;get sector size (0,1,2,3)
	add	a		;*2
	mov	e,a		;copy
	mvi	d,0
	lxi	h,bytsec	;pt at table
	dad	d		;index with hl
	mov	e,m		;get word
	inx	h
	mov	d,m
	mvi	c,09h		;print size
	call	bdos
	call	print
	db	' b/s, $'
	; bit rate
	lda	select		;get sel reg
	ani	30h		;isolate rate bits
	jz	brate1		;normal
	ani	20h		;2.88MB?
	jnz	brate2		;yes
	call	print
	db	'250kHz/$'
	jmp	brate3
brate1:	call	print
	db	'500kHz/$'
	jmp	brate3
brate2:	call	print
	db	'1MHz/$'
brate3:	; RPM
	lda	rpm		;get speed
	ora	a		;which?
	jz	rpm1
	call	print
	db	'300$'
	jmp	rpm2
rpm1:	call	print
	db	'360$'
rpm2:	call	print
	db	' RPM',cr,lf,'$'
	lda	trk0sd		;track 0 special?
	ora	a
	rz			;no
	call	print
	db	'SD track 0',cr,lf,'$'
	ret
bytsec:	dw	s128,s256,s512,s1024
s128:	db	'128$'
s256:	db	'256$'
s512:	db	'512$'
s1024:	db	'1024$'
;+
;
; Set whether track 0 is SD or not (bootable TRS-80 floppy).
;
; Track 0 has to be SD so that the data rate will be slow enough for programmed
; I/O.
;
;-
trk0:	lxi	d,trk0t
	call	keyw
	jmp	badkw
trk0t:	db	1,6,'NORMAL'
	dw	trk0n
	db	1,7,'SPECIAL'
	dw	trk0s
	dw	0
;
trk0n:	xra	a		;a=0
trk0s:	sta	trk0sd		;a=1, set flag
	jmp	next
;
ss:	; single sided
	call	confrm		;confirmed?
	sta	sides		;a already 1 from KEYW
	jmp	next
;+
;
; Get # tracks.
;
;-
trks:	call	decin		;get a #
	jz	trks1		;help
	call	confrm		;confirmed?
	sta	tracks		;save
	jmp	next
trks1:	call	print		;help msg
	db	'Specify number of cylinders (decimal)',cr,lf,'$'
	jmp	loop
;+
;
; Parameters have been set up, actually format the disk.
;
;-
go:	; init the drive
	lda	select		;get select bits
goEFa:	out	0EFh	;PATCH	;turn drive on
	call	recal		;recal the drive
	xra	a		;0
	sta	ctrk		;current track #
	; write single-density track 0 if needed
	lda	trk0sd		;track 0 is SD?
	ora	a
	jz	go1		;no
	lda	select		;get select bits
	ora	a		;SD already?
	jp	go1		;idiot
	ani	7Fh		;clear MFM bit
	sta	select
goEFb:	out	0EFh	;PATCH	;set FM mode
	mvi	a,26		;26 sectors
	sta	cscs
	xra	a		;128 b/s
	sta	csiz
	call	build		;build track
	call	fcyl		;format it
	lda	select		;get select
	ori	80h		;set MFM bit
	sta	select		;back to whatever it was
goEFc:	out	0EFh	;PATCH	;set MFM mode again
	mvi	a,1		;do track 1 next
	sta	ctrk
go1:	; the rest of the disk is normal
	lda	size		;set size
	sta	csiz
	lda	secs		;get # sectors
	sta	cscs
	call	build		;build a table for that
go2:	; format next cylinder
	call	fcyl		;yep
	lda	ctrk		;get track #
	inr	a		;+1
	sta	ctrk		;save
	mov	b,a		;copy
	lda	tracks		;get # tracks wanted
	cmp	b		;done?
	jnz	go2		;loop if not
	call	abort		;stop FDC
	mvi	a,0CFh		;turn drive motor off
goEFd:	out	0EFh
	lda	tracks		;get # tracks
	cpi	80		;did screen wrap?
	jz	go3		;yes
	call	print		;no, print crlf
	db	cr,lf,'$'
go3:	call	print
	db	'Format successful',cr,lf,'$'
	jmp	loop
;
err:	; error exit out of GO
	call	abort		;stop FDC
	mvi	a,0CFh		;turn drive motor off
errEF:	out	0EFh
	jmp	loop
;+
;
; Format a cylinder (both sides).
;
;-
fcyl:	; check for ^C or Esc
	mvi	e,0FFh		;flag=conditional read
	mvi	c,6		;yep
	call	bdos
	cpi	3		;^C?
	jz	fcyla
	cpi	1Bh		;Esc?
	jz	fcyla
	; init for side 0
	xra	a		;side 0
	sta	csid
	lda	select		;get select reg
fcyEFa:	out	0EFh	;PATCH	;select, side 0
	call	seek		;seek to this track
fcyl2:	; format this track
	call	fillin		;fill in data for this side
	mvi	b,5		;retry count
fcyl3:	push	b		;save
	call	abort		;abort whatever's happening
	push	psw		;save a
	call	dmaw		;set up DMA
	pop	psw		;get a
	ani	20h		;head loaded?
	mvi	a,0F4h		;[cmd=write track]
	jnz	fcyl4
	  ori	4		;set E if not (15 ms delay)
fcyl4:	call	cmd		;send command
	mov	c,a		;save a
	mvi	a,83h		;disable DMAC
	out	0F8h
	mov	a,c		;restore
	pop	b		;restore
	ani	0FDh		;check errors
	jz	fcyl5		;no prob
	dcr	b		;retry count exhausted?
	jnz	fcyl3
	call	print
	db	cr,lf,'? Write error',cr,lf,'$'
	jmp	err
fcyl5:	; verify the track
	mvi	a,1		;starting sector #
	sta	csec
fcyl6:	mvi	b,5		;retry count
fcyl7:	push	b		;save
	call	abort		;stop FDC
	push	psw
	call	dmar		;get DMAC ready to read
	lda	csec		;get current sector
fcyE6:	out	0E6h		;set it
	pop	psw
	ani	20h		;head loaded?
	mvi	a,80h		;[read sec, 1 rec, hd 0, 15ms dly, no hd chk]
	jnz	fcyl8
	  ori	4		;set 15ms delay if not
fcyl8:	call	cmd		;read the sector
	mov	c,a		;save result
	mvi	a,83h		;disable DMAC
	out	0F8h
	mov	a,c		;restore
	pop	b		;catch count
	ani	9Dh		;check errors
	jz	fcyl9
	dcr	b		;try -1
	jnz	fcyl7		;loop
	push	psw		;save a
	call	print
	db	cr,lf,'? Read error $'
	pop	psw		;catch
	call	hex		;display it
	call	print
	db	', sector $'
	lda	csec
	call	decout
	call	print
	db	cr,lf,'$'
	jmp	err
fcyl9:	lda	cscs		;get # sectors
	mov	c,a
	lda	csec		;get curr sector #
	cmp	c		;last?
	jz	fcyl10		;yes
	inr	a		;no, +1
	sta	csec
	jmp	fcyl6		;loop
fcyl10:	lda	sides		;get # sides
	dcr	a		;=1?
	jz	fcyl20		;skip if so
	lda	csid		;get side we just did
	ora	a		;done side 1 already?
	jnz	fcyl19		;yep
	inr	a		;=1
	sta	csid		;set side #
	lda	select		;get select reg
	ani	0BFh		;side 1
fcyEFb:	out	0EFh	;PATCH	;select it
	mvi	e,'.'		;+ for side 0
	mvi	c,2
	call	bdos
	jmp	fcyl2		;go
fcyl19:	; done (two-sided)
	mvi	e,8		;backspace
	mvi	c,2		;write
	call	bdos
fcyl20:	; done
	lda	ctrk		;get curr track #
	mvi	e,'0'-1		;digit
fcyl21:	inr	e		;+1
	sui	10		;-10
	jnc	fcyl21		;loop
	cpi	256-10		;was it a multiple of 10?
	jz	fcyl22		;yes
	  mvi	e,'*'		;print a star if not
fcyl22:	mvi	c,2		;write
	jmp	bdos		;and return
fcyla:	; abort
	call	print
	db	cr,lf,'? Aborted',cr,lf,'$'
	jmp	err
;+
;
; Abort FDC.
;
;-
abort:	mvi	a,0D0h		;abort (force interrupt)
abrE4a:	out	0E4h
	call	delay		;delay 16 usec
abrE7:	in	0E7h		;read data reg (clear DRQ)
abrE4b:	in	0E4h		;get status (clear INTRQ)
	mvi	a,0D0h		;abort again (why?)
abrE4c:	out	0E4h
	call	delay		;delay 16 usec
abrE4d:	in	0E4h		;get status
	ret
;
delay:	; >=16. usec delay
	push	b		;save
;	ld	b,5
;	djnz	$		;13 T-states each
	mvi	b,6		;loop count
dly1:	dcr	b		;(4)
	jnz	dly1		;(10)
	pop	b
	ret
;+
;
; Seek to track CTRK.
;
;-
seek:	mvi	b,2		;loop count
seek1:	call	abort		;abort whatever it's doing
	lda	ctrk		;get track #
seek2:	out	0E7h	;PATCH	;write to data reg
	mvi	a,1Ah		;seek, load hd, no vfy, rate=10ms
	call	cmd
	ani	91h		;isolate errors
	rz
	call	recal		;recalibrate
	dcr	b		;-1
	jnz	seek		;loop
	call	print
	db	cr,lf,'? Seek error',cr,lf,'$'
	jmp	err
;+
;
; Recalibrate drive (seek to track 0).
;
;-
recal:	call	abort		;abort FDC
	mvi	a,0Ah		;recal, load hd, no vfy, rate=10ms
	;jmp	cmd		;do it, return, lose errors
;;	ani	95h		;isolate errors
;;	cpi	04h		;TK00 should be set
;;	rz
;;; drop through
;+
;
; Write command in a to FDC, wait for completion, return status in a.
;
;-
cmd:
cmdE4a:	out	0E4h	;PATCH	;write to command reg
;;; Lifeboat delays here
cmdE0:	in	0E0h	;PATCH	;get status
	ani	1		;done?
	jz	cmdE0		;loop if not
cmdE4b:	in	0E4h	;PATCH	;get status
	ret
;+
;
; Set up DMA controller for reading (DMAR) or writing (DMAW)
; (no, these aren't RF08/RS08 6601/6603 instructions).
;
;-
dmar:	lxi	h,dmar1		;pt at table
	mvi	b,ldmar1	;length
	jmp	dmarw
dmaw:	lxi	h,dmaw1		;pt at table
	mvi	b,ldmaw1	;length
dmarw:	mvi	c,0F8h		;addr of DMAC control port (assume only 1)
	dw	otir		;set up
	ret
;+
;
; Parse keyword and look it up.
;
; hl	ptr to line
; de	ptr to keyword table
;
; Table entries:
;	db	min,max	;length of keyword to match
;	db	'string' ;(length=max)
;	dw	addr	;call here on match
; If high bit of MAX is set then that KW isn't shown on ?.
;
; Table ends with a 0 word.
;
; Routine is called with a=1.
;
;-
keyw:	call	skip		;skip blanks
	rz
	push	d		;save table addr
	call	getw		;get keyword
	dcx	h		;-1
	mov	a,m		;get last char
	inx	h
	xthl			;save ptr, get table
	cpi	'?'		;help?
	jz	kwhlp1
kw1:	mov	a,b		;get length
	cmp	m		;too short?
	inx	h
	jc	kw4		;yes
	mov	a,m		;get length of compare string
	inx	h
	ani	7Fh		;lose high bit
	jz	kw6		;end of table, split
	mov	c,a		;save
	cmp	b		;too long?
	jc	kw5		;yes
	; compare to string in table
	push	b		;save b, de
	push	d
kw2:	ldax	d		;get next char of ours
	cmp	m		;match?
	jnz	kw3
	inx	d		;skip
	inx	h
	dcr	c		;length-1
	dcr	b		;done?
	jnz	kw2		;loop
	; it's a match
	pop	d		;clear stack
	pop	d
	mov	e,c		;get remaining length (if abbrev.)
	mvi	d,0
	dad	d		;skip to call addr
	mov	e,m		;get it
	inx	h
	mov	d,m
	pop	h		;get input ptr
	pop	b		;(flush r.a.)
	push	d		;save addr
	mvi	a,1		;set a=1
	ret			;jump to routine
kw3:	; no match
	mov	a,c		;get # to go
	pop	d		;restore
	pop	b
	mov	c,a		;restore # to go
	jmp	kw5		;go skip (C already loaded)
kw4:	; our string is too short to match
	mov	c,m		;get length
	ani	7Fh		;lose "hidden" bit
	inx	h
kw5:	; too long, skip c chars & call addr
	mov	a,b		;save length
	mvi	b,0		;b=0
	dad	b		;skip to call addr
	mov	b,a		;(restore b)
	inx	h		;skip call addr
	inx	h
	jmp	kw1		;loop
kw6:	; not found
	pop	h		;restore
	dcr	a		;(was 0) clear Z flag
	ret
kwhlp1:	; give keyword help
	push	h
	call	print
	db	'A keyword, one of the following:',cr,lf,'$'
	pop	h
;;; what about d, b
	jmp	loop
;+
;
; Parse a word at (hl).
; Return ptr in de, len in b.
;
;-
getw:	mov	d,h		;de=hl
	mov	e,l
	mvi	b,0		;0
	mov	a,m		;get 1st char
getw1:	cpi	'a'		;lower case?
	jc	getw2
	cpi	'z'+1
	jnc	getw2
	ani	0DFh		;convert
	mov	m,a		;store
getw2:	inx	h		;+1
	inr	b		;+1
	mov	a,m		;get char
	cpi	','		;comma?
	rz
	cpi	' '+1		;printing char?
	jnc	getw1		;loop if not
	ret
;+
;
; Check for eol.
;
;-
confrm:	push	psw		;save a
	call	skip		;skip blanks
	jz	cfm1		;no prob
	cpi	','		;comma is OK too
	jz	cfm1
	call	print
	db	'? Not confirmed',cr,lf,'$'
	jmp	loop		;purge stack there
cfm1:	pop	psw		;restore a
	ret
;+
;
; Skip spaces & tabs at (HL).
; RZ if eol.
;
;-
skip1:	inx	h		;+1
skip:	mov	a,m		;get a char
	ora	a		;eol?
	rz
	cpi	' '+1		;blank or ctrl?
	jc	skip1		;yes
	ora	a		;Z=0
	ret
;+
;
; Print in-line string.
;
;-
print:	pop	d		;catch r.a.
	push	d		;save again
	mvi	c,09h		;print
	call	bdos
	pop	h		;restore
pr1:	mov	a,m		;get a char
	inx	h		;+1
	cpi	'$'		;end?
	jnz	pr1		;loop if not
	pchl			;return
;+
;
; Print hex digit in a.
;
;-
hex:	push	psw		;save
	rar			;right 4
	rar
	rar
	rar
	call	hex1		;do 1st dig
	pop	psw		;drop through for 2nd
hex1:	ani	0Fh		;isolate
	cpi	0Ah		;A-F?
	jc	hex2		;no
	  adi	'A'-'9'-1	;skip to letters
hex2:	adi	'0'		;convert
	mov	e,a		;copy
	mvi	c,2		;write
	jmp	bdos		;and return
;+
;
; Read decimal number into a.
; RZ if none or ?.
;
;-
decin:	call	skip		;skip to no.
	rz			;none
	call	getw		;get a word
	ldax	d		;get 1st char
	cpi	'?'		;help?
	rz			;yes
	push	h		;save
	mvi	l,0		;#=0
din1:	ldax	d		;get next digit
	inx	d		;+1
	sui	'0'		;convert to binary
	cpi	10		;valid?
	jnc	din2		;no
	mov	h,a		;save
	mov	a,l		;get low
	add	a		;*2
	add	a		;*4
	add	l		;*5
	add	a		;*10
	add	h		;+new digit
	mov	l,a		;save
	dcr	b		;done?
	jnz	din1		;loop if not
	mov	a,l		;get #
	pop	h		;restore
	dcr	b		;Z=0 (B=FF)
	ret
din2:	; invalid digit
	call	print
	db	'? Invalid decimal digit',cr,lf,'$'
	jmp	loop		;flush stack & restart
;+
;
; Read hex number into a.
; Same deal as above.
;
;-
hexin:	call	skip		;skip blanks
	rz
	call	getw		;get a word
	ldax	d		;get 1st char
	cpi	'?'		;help?
	rz
	push	h		;save
	mvi	l,0
hin1:	ldax	d		;get a char
	inx	d		;skip
	sui	'0'		;convert to binary
	cpi	10		;decimal digit?
	jc	hin3		;yes
	sui	'A'-'0'		;A-F?
	cpi	6
	jc	hin2		;yes
	sui	'a'-'A'		;a-f?
	cpi	6
	jnc	hin4		;no
hin2:	adi	10		;A-F => 10-15
hin3:	mov	h,a		;save
	mov	a,l		;get running total
	add	a		;*2
	add	a		;*4
	add	a		;*8
	add	a		;*16
	ora	h		;+ new digit
	mov	l,a		;save
	dcr	b		;-1
	jnz	hin1		;loop
	mov	a,l		;get #
	pop	h		;restore
	dcr	b		;Z=0 (B=FF)
	ret
hin4:	call	print
	db	'? Invalid hexadecimal digit',cr,lf,'$'
	jmp	loop
;+
;
; Print decimal number in a.
;
;-
decout:	; a scratch
	; b loop count
	; c BCD "bit"
	; e current output digit
	; h NZ if NZ dig has been written
	; l the number
	mvi	h,0		;no digits yet
	mov	l,a		;save
	lxi	b,200h+200	;shift count,,bit value
	mvi	e,'0'/4		;start new digit
dout1:	mov	a,l		;get #
	cmp	c		;will BCD "bit" fit?
	jc	dout2		;no
	inr	h		;(set non-zero flag)
	sub	c		;take the bit
dout2:	mov	l,a		;[save]
	mov	a,e		;[get digit]
	cmc			;flip C
	ral			;C bit into digit
	mov	e,a		;save
	mov	a,c		;get BCD bit
	rrc			;right 1
	mov	c,a		;copy
	dcr	b		;done this dig?
	jnz	dout1		;no
	push	b		;save
	push	h
	mvi	c,2		;write char
	mov	a,h		;get NZ flag
	ora	a		;any non-zero digs yet?
	cnz	bdos		;print this if so
	pop	h		;restore
	pop	b
	mvi	e,'0'/16	;starting value
	mvi	b,4		;bit count
	mov	a,c		;get BCD bit
	mvi	c,80		;new value
	cpi	50		;1st time, right?
	jz	dout1		;loop if so
	mov	a,l		;get remaining #
	ori	'0'		;convert
	mov	e,a		;save
	mvi	c,2		;print regardless of h
	jmp	bdos		;and return
;+
;
; Build track data to write.
;
;-
build:	lxi	d,wbuf		;pt at buffer
	lxi	h,sdtrk		;assume SD
	lda	select		;get select reg
	ora	a		;SD or DD?
	jp	bld1
	  lxi	h,ddtrk		;DD
bld1:	call	fildat		;do header
	lda	cscs		;get # sectors
	mov	b,a		;save
bld2:	; do next sector
	push	b		;save
	push	h
	call	fildat		;do header
	lxi	b,8001h		;assume length=128
	lda	csiz		;get sector size
	ora	a		;=0?
	jz	bld3
	lxi	b,1		;256?
	dcr	a
	jz	bld3
	inr	c		;512?
	dcr	a
	jz	bld3
	mvi	c,4		;1024
bld3:	mvi	a,0E5h		;data
bld4:	stax	d		;write
	inx	d
	dcr	b		;loop
	jnz	bld4
	dcr	c		;outer loop
	jnz	bld4
	call	fildat		;do trailer
	pop	h		;restore header
	pop	b
	dcr	b		;done?
	jnz	bld2		;do next if not
	lxi	h,-wbuf-12500-50 ;size we want (50 guard bytes)
	dad	d		;find -(# bytes to go)
	jc	bld99		;bad
	mvi	b,0FFh		;assume SD
	lda	select		;get select bits
	ora	a
	jp	bld5		;skip
	  mvi	b,4Eh		;DD
bld5:	mov	a,b		;copy
	stax	d		;store
	inx	d		;+1
	inx	h		;count
	mov	a,h		;done?
	ora	l
	jnz	bld5		;loop if not
	ret
bld99:	call	print
	db	cr,lf,'? Too many sectors',cr,lf,'$'
	jmp	err
;+
;
; Fill out data field.
;
; hl	ptr to table of (db count, db data) (count=0 marks end)
; de	ptr to buf to full
;
; Both updated on return.
;
;-
fildat:	mov	a,m		;get a byte
	inx	h		;+1
	ora	a		;end?
	rz
	mov	b,a		;length
	mov	a,m		;data
	inx	h		;+1
fdat1:	stax	d		;save
	inx	d
	dcr	b		;done?
	jnz	fdat1
	jmp	fildat		;loop
;+
;
; Fill in track, side, sector, length fields for this track.
;
;-
fillin:	lxi	h,128/2		;min sector length
	lda	csiz		;get size flag
	inr	a
fill1:	dad	h		;*2
	dcr	a		;count it up
	jnz	fill1
	lda	select		;get density flag
	ora	a		;which is it?
	jp	fill2		;single
	lxi	d,114-3		;114=size of header+trailer (116 incl CRC)
	dad	d		;add to sector length
	lxi	d,wbuf+146+16	;pt at first
	jmp	fill3
fill2:	lxi	d,58-3		;58=size of header+trailer (60 incl CRC)
	dad	d		;add to sector length
	lxi	d,wbuf+73+7	;pt at first
fill3:	; de=ptr to first header, hl=length of hdr+sec+trl -3
	xchg			;swap 'em
	lda	cscs		;get # sectors
	mov	b,a		;copy
	mvi	c,1		;starting sector #
fill4:	lda	ctrk		;track #
	mov	m,a
	inx	h		;+1
	lda	csid		;head #
	mov	m,a
	inx	h		;+2
	mov	m,c		;sector #
	inx	h		;+3
	lda	csiz		;sector length
	mov	m,a
	dad	d		;+length-3=begn of next
	inr	c		;bump sector #
;;; might want to handle interleaves other than 1
	dcr	b		;done?
	jnz	fill4		;loop if not
	ret
;
; SD track build table
; Data rate=250kHz
; 5208.33 bytes/track @ 360 RPM
; 6250 bytes/track @ 300 RPM
;
sdtrk:	db	40,0FFh
	db	6,0
	db	1,0FCh		;index mark
	db	26,0FFh
	db	0		;end of track header
	db	6,0
	db	1,0FEh		;ID AM
	db	4,0		;track, side, sector, length
	db	1,0F7h		;CRC
	db	11,0FFh
	db	6,0
	db	1,0FBh		;data AM
	db	0
	db	1,0F7h		;CRC
	db	27,0FFh
	db	0		;end of sector
;
; DD track build table
; Data rate=500kHz
; 10416.67 bytes/track @ 360 RPM
; 12500 bytes/track @ 300 RPM
;
ddtrk:	db	80,4Eh
	db	12,0
	db	3,0F6h		;(writes 0C2h)
	db	1,0FCh		;index mark
	db	50,4Eh
	db	0		;end of track header
	db	12,0
	db	3,0F5h		;(writes 0A1h)
	db	1,0FEh		;ID AM
	db	4,0		;track, side, sector, length
	db	1,0F7h		;CRC
	db	22,4Eh
	db	12,0
	db	3,0F5h		;(writes 0A1h)
	db	1,0FBh		;data AM
	db	0
	db	1,0F7h		;CRC
	db	54,4Eh
	db	0		;end of sector
;
; These tables flagrantly stolen from Lifeboat's FORMAT.COM program.
;
dmar1:	db	0C3h		;WR6 reset
	db	8Bh		;WR6 reset eob flag
	db	69h		;WR0 xfr B => A (db port, dw blklen follow)
rport:	db	0E7h		;read port
	dw	-1		;length -1 (we use FDC BUSY bit to finish)
	db	3Ch		;WR1 A=fixed I/O addr
	db	10h,8Dh		;WR2 B=inc'ing mem addr, WR4 byte, addr is..
	dw	rbuf		;read buf addr
	db	8Ah		;WR5 XFERRQ is active high (well..)
	db	0CFh		;WR6 load port B
	db	05h		;WR0 xfr A => B (just kidding before)
	db	0CFh		;WR6 load port A
	db	87h		;WR6 enable
ldmar1	equ	$-dmar1
;
dmaw1:	db	0C3h		;WR6 reset
	db	8Bh		;WR6 reset eob flag
	db	79h		;WR0 xfr A => B (dw addr,blklen follow)
	dw	wbuf		;write buf addr
	dw	-1		;length -1 (we use FDC BUSY bit to finish)
	db	14h		;WR1 A=inc'ing mem addr
	db	28h,85h		;WR2 B=fixed I/O addr, WR4 byte, addr is..
wport:	db	0E7h		;oh baby
	db	8Ah		;WR5 XFERRQ is active high (when DMAC sees it)
	db	0CFh		;WR6 load port B addr
	db	05h		;WR0 xfr A => B
	db	0CFh		;WR6 got it?  miserable sack of shit
	db	87h		;WR6 enable
ldmaw1	equ	$-dmaw1
;
port	db	0E0h		;base FDC I/O port
sides	db	1		;# sides
tracks	db	77		;# tracks
secs	db	26		;# sectors
size	db	1		;sector size (0=128, 1=256, 2=512, 3=1024)
select	db	0CEh		;select reg (EF) value bits as follows:
				;<7> 1=MFM (DD/HD), 0=FM (SD)
				;<6> 1=side 0, 0=side 1
				;<5> don't care (select 1MHz clock on mine)
				;<4> don't care (select 500kHz clock on mine)
				;<3:0> drive sel 3-0, active low (1 at a time)
rpm	db	0		;0=360 RPM (8" or 5.25" HD)
				;1=300 RPM (5.25" DD or 3.5")
trk0sd	db	0		;NZ => track 0 is SD with sector size /2
;
csid	db	0		;current side #
ctrk	db	0		;current track #
csec	db	0		;current sector #
csiz	db	0		;current sector size
cscs	db	0		;# of sectors/track
;
	ds	100h		;stack
stack:	; stack ends here
kbbuf:	ds	2+80+1		;2 lengths, buf, space for our 0
lkbbuf	equ	$-kbbuf-3
wbuf:	; track data are written here
rbuf	equ	$+26000		;max track is 25000 (2.88MB floppy, dream on)
	end