;******************************************************
; North Star Disk Exerciser for CP/M
;    (Double Density Controller)
;
; Commands:
;
;     BO         Boots from disk
;     LH         Load head and keep it loaded, with
;                option to nudge the head either way
;     MS         Measure spindle revolution time
;     RE         Restore to track 0
;     RS S AAAA  Read sector S into memory at
;                address AAAA
;     SK [TT]    Seek track TT
;     SH [0|1]	 Select head (0=bottom, 1=top)
;     ST [40|80] Select number of tracks (40 or 80)
;     SU U       Select disk unit (1-4)
;     WS S AAAA  Write sector S from memory at
;                address AAAA
;     ?          brief help screen
;
;     Addresses are specified in hex. All other numbers
;     are entered in decimal.
;
;******************************************************
; Notes
;
; Nudging:
; Some drives exhibit 'gear lash' in the head
; positioner - the head will be off-track slightly
; toward the outside diameter when a track is
; approached from the outside (stepping toward a higher
; track), and will be off-track slightly toward the
; inside diameter when a track is approached from the
; inside (stepping toward a lower track). The nudge
; sub-commands of the LH function (+ and -) allow you
; to approach the alignment track from either
; direction to observe this difference.
; 
; Use the LH function to keep the head loaded during
; radial alignment. Nudge the head in both directions
; while performing the alignment, and balance the
; alignment between the two directions.
;
; Spindle Rotation measurement:
; The MS command first measures the CPU speed by
; measuring the time for the Northstar controller
; to generate 125 fake sector pulses while no drive
; is selected. It then uses this measured CPU speed
; to measure the time for 50 actual sector pulses
; (5 disk revolutions). This assumes NODDEXER is running
; in zero waitstate RAM.Use this function to adjust
; the drive's spindle rotation speed to be
; 200 mS/revolution. Allow the spindle motordrive to
; warm up for a few minutes before adjusting, as it
; will speed up by about 1% as it wartms up.
;******************************************************
; Revision History
; 1.0   29 October 2015  M. Eberhard & M. Douglas
;	Original release
;
; 1.1	01 January 2016  M. Douglas
;	Change CH CT commands to SH ST for consis-
;	tency with the SU command.
;
;******************************************************

FALSE	equ	0
TRUE	equ	not FALSE

;*************
; CP/M Equates
;*************
;------------------------------------------
;BDOS Entry Points and low-memory locations
;------------------------------------------
WBOOT	equ	0000H		;Jump to BIOS warm boot
WBOOTA	equ	WBOOT+1		;Address of Warm Boot
BDOS	equ	WBOOT+5		;BDOS Entry Point
COMBUF	equ	WBOOT+80H	;disk & cmd line buffer
USAREA	equ	WBOOT+100H	;User program area

LINBUF	equ	COMBUF		;use CP/M's buffer for input
LBSIZE	equ	64		;max input line (huge)

;------------------------------------------
;BDOS Function Codes, passed in register C
;------------------------------------------
;BRESET	equ	0	;System Reset
;BCONIN	equ	1	;Read Console Chr
;BCONOT	equ	2	;Type Chr on Console
;BPRINT	equ	9	;Print $-terminated String
BRDCON	equ	10	;Get Line from Console
;BCONST	equ	11	;Console Status (<>0 IF CHR)
;BDRST	equ	13	;Reset Disk
;BSDISK	equ	14	;select disk
;BOPEN	equ	15	;Disk File Open
;BCLOSE	equ	16	;Close disk file, FCB at de
;BSERCH	equ	17	;Search dir for file, FCB at de
;BDELET	equ	19	;delete file, FCB at (de)
;BREAD	equ	20	;Read from Disk, 0=OK, <>0=EOF
;BWRITE	equ	21	;Write next record, 0=OK, <>0=ERR
;BMAKE	equ	22	;Make new file, 0FFH=BAD
;BCDISK	equ	25	;get current disk
;BSTDMA	equ	26	;Set disk buffer to (de)

;--------------------------------------------------------
;BIOS Entry Points, relative to the base address in WBOOT
;--------------------------------------------------------
CONST	equ	06h	;Console Status
CONIN	equ	09h	;Console Input
CONOUT	equ	0Ch	;Console output

;************************************************
; Northstar DD Controller Addresses & Commands
; (Read or write from address to execute command)
;************************************************
NSCTRL	equ	0E800h		;North Star disk controller
NSBOOT	equ	NSCTRL		;disk boot PROM entry point
NWRITE	equ	NSCTRL+100h	;write prefix (data in low byte)
NORDER	equ	NSCTRL+200h	;controller order base address
NCOMND	equ	NSCTRL+300h	;commands base address

NASTAT	equ	NCOMND+10h	;read A status
NBSTAT	equ	NCOMND+20h	;read B status
NCSTAT	equ	NCOMND+30h	;read C status
NMOTRA	equ	NCOMND+15h	;motor on, read A status
NRBYTE	equ	NCOMND+40h	;read a byte of disk data
NWRCRD	equ	NCOMND+16h	;start write-sector sequence
NRSEFL	equ	NCOMND+11h	;reset sector flag, read A status
NRESET	equ	NCOMND+17h	;reset controller

;****************************
; Controller Order Register Bits
;****************************
NDBLDEN	equ	080h		;select double density mode

NTOPSID	equ	040h		;select top side of DS disk

NSTPIN	equ	020h		;step in
NSTPOUT	equ	000h		;step out

NPREON	equ	020h		;write pre-comp on
NPREOFF	equ	0dfh		;write pre-comp off
NPRETRK	equ	21		;precomp on starting with this track

NSTEPH	equ	010h		;assert step line
NSTEPL	equ	0efh		;de-assert step line


;****************************
; Status Register Bits
;****************************
; Status Register A

NSBDY	equ	1		;body (sync chr found)
NSRE	equ	4		;read enable (PLL locked)
NSWIND	equ	8		;in 96us pre-sector window

; Status Register B

NSTR0	equ	1		;track 0
NSWP	equ	2		;write protect

; Status Register C (sector position

NSSP	equ	0Fh		;sector position

; All status registers

NSMO	equ	10h		;motor on flag
NSDD	equ	20h		;double density flag
NSWN	equ	40h		;window flag
NSSF	equ	80h		;Nsector flag

;**************************
; Disk Controller constants
;**************************
SYNC	equ	0FBh		;header sync charactor
WRMUP	equ	32h		;warm up time in sectors
SETL	equ	0Dh		;head settling time in sectors
SWAIT	equ	08Ch		;max wait for body before error
MAXUNT	equ	4		;max disk drive unit (0 not allowed)
MAXSEC	equ	9		;max sector (SA400 and SA400L)

;**************
; ASCII equates
;**************
ASCII	equ	30h		;ASCII number bias
CTRLC	equ	03h		;^C
CR	equ	0Dh		;carriage return
LF	equ	0Ah		;line feed
ESC	equ	1Bh		;"ESCAPE" KEY
QUOTE	equ	27h		;Single quote
BS	equ	5Fh		;Backspace???? for Sol-20???
DEL	equ	7Fh		;delete

;******************
; Program Constants
;******************
DPRMPT	equ	'+'		;Disk test prompt
MAXINP	equ	64		;longest allowed user input

;=============================================
; Initialization
;=============================================
	org	USAREA

	di
	lxi	sp,STACK	;local stack

	lxi	h,01FFh		;initialize CRTRAK & CRUNIT
	shld	CRTRAK

	mvi	a,NDBLDEN+1	;init order register to double density
	sta	CTLORD		;   and drive 1 selected

	mvi	a,40		;default to 40 tracks
	sta	DRVSIZ

	call	CILPRT
 db 'Northstar Double Density Disk Exerciser Vers. 1.1',CR,LF
 db '      by Martin Eberhard & Mike Douglas',CR,LF,LF
 db 'Type ? for help',CR,LF+80h

	jmp	CPROC		;start main loop


;**********************************
; Disk Test Subsystem Command Table
;**********************************
NSTAB:	db	'BO'		;Boot
	dw	ASKBOT
	db	'LH'		;load head
	dw	LHCMD
	db	'MS'		;measure spindle speed
	dw	NSMSPD
	db	'RE'		;restore
	dw	NSRSTR
	db	'RS'		;read sector
	dw	NSREAD
	db	'SK'		;seek track
	dw	NSSEEK
	db	'SH'		;select head (top/bottom)
	dw	SHCMD
	db	'ST'		;set number of tracks
	dw	STCMD
	db	'SU'		;select unit
	dw	NSUNIT
	db	'WS'		;write sector
	dw	NSWRIT
	db	'?',0		;help
	dw	NSHELP
	db	0		;table end

;******============================
;* ?  *   Help
;****** 
;==================================
NSHELP:	call	CILPRT
 db 'BO         Boot from A:',CR,LF
 db 'LH         Load/unload head (drive select/deselect)',CR,LF
 db 'MS         Measure spindle rotation',CR,LF
 db 'RE         Restore',CR,LF
 db 'SK [tt]    Seek track tt (0-39/79)',CR,LF
 db 'SH [0|1]   Select head (0=bottom, 1=top)',CR,LF
 db 'ST [40|80] Select number of tracks (40 or 80)',CR,LF
 db 'SU [u]     Select drive unit (1-4)',CR,LF
 db 'RS s aaaa  Read sector s (0-9) into RAM at address aaaa',CR,LF
 db 'WS s aaaa  Write sector s (0-9) from RAM at address aaaa',CR,LF,LF
 db 'Addresses are hex, all others are decima','l'+80h
;    123456789012345678901234567890123456789012345678901234567890

	ret

;================================
;Command Processor for Subsystems
;================================

;*******************
;bogus command input
;*******************
BADINP:	call	CILPRT
	db	'huh','?'+80h

; Fall into CPROC

;*************************************************
; Command Processor Main Entry
; gets and process commands
; On Entry:
;  COMTAB = address of command table,
;           which preceeds the execution routines
;  first table byte = current prompt character
;*************************************************
CPROC:	lxi	sp,STACK	;repair stack

	call	CILPRT		;print prompt
	db	DPRMPT+80h

	lxi	d,CPROC		;create return address
	push	d		;..on the stack

;get a line of input from the user

	call	GETLIN
	rz			;No command? no error.

;Look for and execute the command if found

	lxi	h,NSTAB-1	;command table
	xchg			;command to hl
				;..table to de

;search through table at de for a 2-chr match of (hl)

NXTCOM:	inx	d		;skip over address high byte

	ldax	d
	ora	a		;table end?
	jz	BADINP		;y: unknown command

	xra	m		;test first chr
	mov	b,a		;temp save result
	inx	d		;2nd table chr
	ldax	d
	inx	h		;2nd input chr
	xra	m		;test 2nd chr

	inx	d		;point to address low byte
	inx	d		;point to address high byte

	dcx	h		;back to 1st input chr
	ora	b		;both chrs match?
	jnz	NXTCOM		;NO match: keep looking

;Got a match. Get routine address and put it on stack

	xchg			;(hl)=routine address high byte
				;de= input pointer

	mov	b,m		;get routine address from table
	dcx	h
	mov	c,m		;bc=routine address
	push	b		;command address on stack

	inx	d		;skip past 2-letter command
	inx	d

;get the following parameter (if any) and put it in hl.
;set the Z flag if no parameter is present.
;leave de pointing to the 1st chr after the 1st parameter.
;'return' to the command routine on the stack.

; fall into GETDEC

;***Subroutine**************************************
; Skip spaces, then convert ASCII decimal digits in
; input buffer to binary. Stop when a space or the
; end is encountered. Bad decimal aborts via BADINP.
; On Entry:
;    Input string starts at (de)
; On Exit:
;    Z set if no value found
;    abort to BADINP for bogus decimal or value>99
;    b=value, default = 0
;    de advanced past chr
; trashes c
;***************************************************
GETDEC:	mvi	b,0		;initial value
	call	SKIPB		;skip blanks
	rz			;no input: Z set

GDLOOP:	ldax	d		;get character
	ora	a		;end of line?
	jz	GH1		;Y: done

	cpi	' '		;end of parameter?
	jz	GH1

	sui	'0'		;un-ascii
	cpi	10		;valid?
	jnc	BADINP

	mov	c,a		;temp save new digit

	mov	a,b		;multiply by 10
	cpi	10		;will next digit overflow?
	jnc	BADINP		;too big?

	add	a		;x2
	add	a		;x4
	add	b		;x5
	add	a		;x10
	add	c		;combine digits
	mov	b,a		;save partial result

	inx	d		;bump the pointer
	jmp	GDLOOP		;get more digits

;***Subroutine**************************************
; Skip spaces, then convert ASCII hex digits in
; input buffer to binary. Stop when a space or the
; end is encountered. Bad hex aborts through BADINP.
; On Entry:
;    Input string starts at (de)
; On Exit:
;    Z set if no value found
;    abort to BADINP for bogus hex
;    hl=value, default = 0
;    de advanced past chr
; trashes a,c
;***************************************************
GETHEX:	lxi	h,0		;default value

	call	SKIPB		;skip blanks
	rz			;no input: Z set

GHEXLP:	ldax	d		;get character
	ora	a		;end of line?
	jz	GH1		;Y: done

	cpi	' '		;value separator?
	jz	GH1		;Y: done

	dad	h		;make room for the new one
	dad	h
	dad	h
	dad	h
	call	HEXCON		;do the conversion
	jc	BADINP		;bogus hex: error

	add	l
	mov	l,a		;move it in

	inx	d		;bump the pointer
	jmp	GHEXLP

GH1:	inr	a		;good value: clear Z flag
	ret

;***Subroutine*************************
;  Convert ASCII hex digit to binary
; On Entry:
;   a=chr to convert
; On Exit:
;   a=binary
;   carry clear if OK, set if bogus chr
;**************************************
HEXCON:	sui	'0'		;remove ASCII bias
	cpi	10
	cmc			;so carry means error
	rnc			;IF 0-9 then we're done

	sui	'A'-'9'-1	;subtract gap to ASCII A
	cpi	10		;netween ASCII 9 and A?
	rc			;error:return w/ carry
	cpi	10h		;above ASCII F?
	cmc			;so carry means error
	ret			;return with or w/o carry

;***Subroutine***********************************
;Get a line of input from the user
;Scan past blank positions looking for the first
;non-blank character. This assumes that LINBUF
;fits fully within one page of RAM.
; On Exit:
;   Z set, carry clear if none found
;   a=1st character value if found
;   carry set if chr is below ' '
;   de = address of 1st non-blank chr
;***********************************************
GETLIN:	mvi	c,BRDCON	;get user input
	lxi	d,LINBUF	;give CP/M a buffer
	push	d

	mvi	a,LBSIZE	;buffer size
	stax	d
	call	BDOS		;get input line

;convert lower case to upper case

	pop	d		;de->LINBUF
	inx	d		;de->byte count (from BDOS call)
	ldax	d		;a=byte count
	mov	c,a		;c=byte count

	inx	d		;de->start of input characters
	push	d		;stack has pointer to start of data

GLLOOP:	ldax	d		;a=next character from buffer
	cpi	'A'		;alpha?		
	jc	GLSKIP		;no, skip it

	ani	5fh		;convert to upper case
	stax	d
		
GLSKIP:	inx	d		;de->next character position
	dcr	c		;decrement buffer length count
	jnz	GLLOOP

;store two trailing null characters

	xra	a
	stax	d		;paste in terminating null
	inx	d		
	stax	d		;2nd null in case one char command

;skip leading blanks, and set Z for blank lines

	pop	d		;Beginning of user input

; fall into SKIPB

;***Subroutine***********************************
;Scan past blank positions looking for the first
;non-blank character.
; On Entry:
;   de = address of next input buffer chr
; On Exit:
;   Z set, carry clear if none found
;   a=1st character value if found
;   carry set if chr is below ' '
;***********************************************
SKIPB:	ldax	d		;get next character
	ora	a		;end of line?
	rz

	cpi	' '
	rnz			;we are past blanks

	inx	d		;next scan address
	jmp	SKIPB		;keep skipping

;***Subroutine*******
; Print CR, LF
; Trashes psw
;********************
PCRLF:	call	ILPRNT
	db	CR,LF+80H
	ret
		
;***Subroutine*****************************************
; Print CR, LF, then In-line Message
;  The call to ILPRNT is followed by a message string.
;  The last message chr has its msb set.
; Trashes psw
;******************************************************
CILPRT:	call	PCRLF

; fall into ILPRNT

;***Subroutine*****************************************
; Print In-line Message
;  The call to ILPRNT is followed by a message string.
;  The last message chr has its msb set.
; On Exit:
;  Z cleared
; Trashes psw
;******************************************************
ILPRNT:	xthl			;Save hl, get msg addr
	push	b

IPLOOP:	mov	a,m
	ani	7Fh		;strip end marker
	mov	c,a
	call	PRINTC		;print byte
	mov	a,m		;end?
	inx	h		;Next byte
	ora	a		;msb set?
	jp	IPLOOP		;Do all bytes of msg

	pop	b
	xthl			;Restore hl,
				;..get return address
	ret

;******==================================
;* BO *  Boot from Northstar Disk after
;******  Asking the user to insert a disk
;========================================
ASKBOT:	call	CILPRT
 db 'Boot drive A (Y/N)','?'+80h

	call	GETLIN

	cpi	'N'		;abort?
	jz	CPROC		;y: go to command

	cpi	'Y'
	jz	NSBOOT		;boot from disk

	jmp	ASKBOT

;******================================
;* LH *   Load Head and Keep it Loaded.
;******    'H' toggles head load (drive select)
;	   'M' toggles motor on/off 
;          '+' nudges in then out
;          '-' nudges out then in 
;          'Q' quits
;=====================================
LHCMD:	call	CILPRT
	db	'H toggles head load (drive select)',CR,LF
	db	'M toggles motor on/off (drive select & motor)',CR,LF
	db	'+ nudges in then out',CR,LF
	db	'- nudges out then in',CR,LF
	db	'Q quits',CR,LF+80h

LHSLCT:	mvi	d,0		;start with drive selected
	call	CILPRT
	db	'SELECTED (head loaded, motor started)',' '+80h

LHLOOP:	mov	a,d
	rrc
	cc	UNSLCT
	cnc	NSELCT

	call	TESTQ		;Anything from kbd?

	mvi	e,NSTPIN	;e=step in 
	cpi	'+'		;approach from the OD?
	cz	HNUDGE

	mvi	e,NSTPOUT	;e=step out
	cpi	'-'		;approach from the ID?
	cz	HNUDGE

	cpi	'M'		;motor toggle?
	jnz	LHCHKH		;no, go check for H command

	mov	a,d		;test current select state
	rrc
	jc	LHSLCT		;presently de-selected, go select

	inr	d		;change to de-selected state
	lda	NRESET		;reset deselects and turns off motor
	call	CILPRT
	db	'DE-SELECTED (head unloaded, motor off)',' '+80h

	jmp	LHLOOP

LHCHKH:	cpi	'H'		;toggle head state?
	jz	LHTGLH		;yes

	cpi	' '		;accept space too
	jnz	LHLOOP

LHTGLH:	mov	a,d		;test current select state
	rrc
	jc	LHSLCT		;presently de-selected, go select

	inr	d		;change to de-selected state
	call	CILPRT
	db	'DE-SELECTED (head unloaded)',' '+80h

	jmp	LHLOOP

;---Local Subroutine--------------
; Nudge the head one track
; On Entry:
;   e = order register s
; Returns with a=0 or 2
; trashes psw,e,h 
;---------------------------------
HNUDGE:	mvi	h,1		;1 step
	call	NSSTEP

	mvi	h,1		;1 step again
	mov	a,e
	xri	NSTPIN		;toggle direction
	mov	e,a
	jmp	NSSTEP

;---Local Subroutine--------------
; unselect drive 
; trashes hl (preserves psw)
;---------------------------------
UNSLCT:	push	psw		;preserve flags
	lda	CTLORD		;clear drive select field
	ani	0F0H		;  in lower four bits
	mov	l,a		;l=controller order

	mvi	h,NORDER/256	;h=MSB of controller order address
	mov	a,m		;issue order

	pop	psw		;restore flags
	ret


;******================================
;* SH *   Select Head to top or bottom side
;******     0=bottom head, 1=top head
;	    if no parameter specified, current
;	    head status is displayed.
;=====================================
SHCMD:	lda	CTLORD		;a=controller order with head bit
	jz	SHSTAT		;no param, display current status 

; a parameter of anything but 1 defaults to bottom head

	dcr	b		;see if parameter is one
	jz	SHSELT		;yes, select top head

	ani	(NOT NTOPSID) AND 0ffh	;clear head bit
	jmp	SHSAVE		;save and display head status

SHSELT:	ori	NTOPSID		;set head bit

SHSAVE:	sta	CTLORD		;save updated controller order
SHSTAT:	ani	NTOPSID		;isolate top/bottom bit
	jnz	SHTOP		;top is selected
	
	call	CILPRT
	db	'Botto','m'+80h
	jmp	SHST2		;finish rest of message

SHTOP:	call	CILPRT
	db	'To','p'+80h

SHST2:	call	ILPRNT
	db	' head selecte','d'+80h

	ret

;******================================
;* ST *   Set Tracks to 40 or 80 
;******    Anything but 80 defaults to 40
;	   Updates DRVSIZ with 40 or 80
;=====================================
STCMD:	lda	DRVSIZ		;a=current drive size
	jz	STSTAT		;no param, display current status 

; a parameter of anything but 80 defaults to 40 tracks

	mov	a,b		;a=tracks parameter
	cpi	80
	jz	STSAVE		;80 selected - save it

	mvi	a,40		;otherwise, 40 tracks

STSAVE:	sta	DRVSIZ		;save updated number of tracks
	cma			;set msbit
	sta	CRTRAK		;force track to unknown
	cma			;restore number of tracks

STSTAT:	mov	b,a		;b=number of tracks
	call	PCRLF
	call	DSPDEC		;display the number of tracks
	call	ILPRNT
	db	' tracks per sid','e'+80h

	ret

;******=============================
;* MS *   Measure and report spindle
;******   revolution time in mSec
;===================================
NSMSPD:

;----------------------------------------------------
;Measure CPU speed by comparing to the Northstar disk
;controller's clock. (The N* contoller will generate
;32.768 mS "sector" pulses when no drive is selected. 
; (1000 * 2^16/2,000,000hz = 32.768 mS)
;----------------------------------------------------
	call	CILPRT
	db	'Measuring CPU Speed:',' '+80h

	call	UNSLCT		;deselect drive

	mvi	a,125		;time 125 "sectors"
	call	TIMSEC

;divide result in (b,hl) by 8 to get CPU speed in 102.4 Hz units

	mvi	c,3

DIV8LP:	xra	a		;clear carry
	mov	a,b
	rar
	mov	b,a
	mov	a,h
	rar
	mov	h,a
	mov	a,l
	rar
	mov	l,a

	dcr	c
	jnz	DIV8LP

	mov	a,b		;result too big?
	ora	a
	jnz	TOOBIG		;y: error, exit

	lxi	d,-10240	;print CPU speed and divide
				;result by 1024 while doing
				;..decimal conversion
	mvi	a,4		;4 digits after the decimal
	call	DIVIDE		;result lands in QOTENT

	call	ILPRNT
	db	' MHz',' '+80h

;detect and report type of CPU

	sub	a		;test for 8080 or Z80
	cpe	IS8080
	cpo	ISZ80

	call	ILPRNT
	db	'80 CPU detecte','d'+80h

;compute hl= -(cpu speed) for rev-timing math

	lhld	QOTENT		;binary CPU speed
	mov	a,h		;compute -(CPU speed)
	cma
	mov	h,a
	mov	a,l
	cma
	mov	l,a
	inx	h		;complement and add 1

;------------------------------------------------
;Measure the spindle speed by counting cycles and
;dividing by the measured CPU speed. Do this over
;and over until the user types MODE Select key.
; hl = -(CPU speed)
;------------------------------------------------
	push	h		;-(cpu speed) onto stack

	call	NSELCT		;load the head

	call	CILPRT
	db	'Measuring spindle revolutions. Q to quit.',CR,LF+80h

MSLOOP:	mvi	a,50		;50 sectors to time
	call	TIMSEC		;time 50 sectors
				;..result in (b,hl)

;(b,hl) = cycle count for 50 sectors

	mov	a,b
	ani	0FEh		;17 bits max
	jnz	TOOSLO

;time (uS/rev) = ((b,hl)*10) / (CPU speed)

	pop	d		;de= -(CPU speed)
	push	d		;save for next pass

	mvi	a,2		;2 digits after decimal pt
	call	DIVIDE		;divide (b,hl) by CPU speed
				;..print result in mS

	call	ILPRNT
	db	' mSec/rev',CR,LF+80h

;Keep measuring until the user types Mode Select

MSLP2:	call	TESTQ
	jmp	MSLOOP	

; Error: CPU speed is too big

TOOBIG:	call	ILPRNT
	db	'out of rang','e'+80h
	ret

; Error: spindle is too slow

TOOSLO:	call	CILPRT
	db	'Spinde too slo','w'+80h
	jmp	MSLP2

;---Local Subroutine-----------
;Print 1st part of 8080 message
; On Exit:
;  Parity is even
;------------------------------
IS8080:	call	ILPRNT
	db	'8','0'+80h
	sub	a		;set parity even again
	ret

;---Local Subroutine-----------
;Print 1st part of Z80 message
;------------------------------
ISZ80:	call	ILPRNT
	db	'Z'+80h
	ret
	
;******============================
;* RE *   Restore Disk to Track 0
;****** 
; On Exit:
;   Z set and curCyl=0 if track 0 found
; trashes b,c,e,h
;==================================
NSRSTR:	call	NSELCT		;select drive, spin up

;step in once, in case the head is lost

	mvi	e,NSTPIN	;e=step in request
	mvi	h,1		;h=number of steps
	call	NSSTEP		;step in now
	jz	STUCK0		;z: Stuck on track 0

;step out enough times that we should find track 0 even
;if an SA400's actuator is out of its spiral groove

	lda	DRVSIZ		;a=tracks on drive
	adi	16		;16 extra steps if needed
	mov	h,a		;h=max tracks t step
	mvi	e,NSTPOUT	;e=step out request
	call	NSSTEP		;steppin' out to track 0
	rz			;z set: found track 0

;Error: track 0 not detected despite many steps outward

	call	CILPRT		;can't find track 0
	db	'No track ','0'+80h
	jmp	CPROC		;repair stack & quit

;******==============================
;* RS *   Read Sector (0-9)
;****** 
; On Entry:
;    b  = desired sector number
;   (de) = Memory address
; On Exit:
;    clobbers b,c,h,l
;====================================
NSREAD:	jz	BADINP		;no parameter specified
	call	NSETUP		;set up for read/write

	mvi	b,SWAIT		;max time until body

;wait for RE bit (PLL lock) 

NSRD1:	dcr	b
	jz	NOSYNC		;timeout, sync not found
	lda	NASTAT		;look for RE, PLL lock flag
	ani	NSRE
	jz	NSRD1		

;wait for body bit (sync character found)

NSRD2:	dcr	b
	jz	NOSYNC		;timeout, sync not found
	lda	NASTAT		;look for "body" flag in stat A
	rrc			;test for NSBDY bit
	jnc	NSRD2

	lxi	b,0		;init CRC (b), byte count (c)

;read sector data two bytes at a time (512 bytes total)

NSRD3:	lda	NRBYTE		;read a byte
	mov	m,a		;save it
	xra	b		;compute checksum
	rlc
	mov	b,a
	inx	h		;bump pointer

	lda	NRBYTE		;read a byte
	mov	m,a		;save it
	xra	b		;compute checksum
	rlc
	mov	b,a
	inx	h		;bump pointer

	dcr	c		;256*2 byteS
	jnz	NSRD3

;check CRC

	lda	NRBYTE		;get disk CRC
	xra	b		;compare to computed CRC
	rz			;Z flag set if OK, else error

	call	CILPRT
	db	'CRC erro','r'+80h
	ret

;******===============================
;* SU *   Set Unit (1-4)
;****** 
; On Entry:
;    b = desired unit
; On Exit:
;    CTLORD = updated with desired unit
;    CRTRAK < 0, since we don't Know
;            Where we are anymore
;=====================================
NSUNIT:	jnz	SUSET		;unit parameter is present

	call	CILPRT
	db	'Current unit is',' '+80h

	lda	CRUNIT		;display current unit number
	mov	b,a
	jmp	DSPDEC

SUSET:	mov	a,b
	dcr	a		;only 1-4 allowed
	cpi	MAXUNT
	jnc	BADINP

;save drive number in CRUNIT and then encode the drive number
;  as a bit position and store in CTLORD

	inr	a		;drive number is 1-4
	sta	CRUNIT

	cpi	3
	jc	SVUNIT		;1->1, 2->2
	rlc			;3->6, 4->8
	ani	0ch		;3->4, 8->8

SVUNIT:	mov	b,a		;b=encoded drive value

	cma			;sets msb
	sta	CRTRAK		;don't know where we are

	lda	CTLORD		;a=current order register
	ani	0f0h		;clear out drive bits
	ora	b		;a=order register with drive bits
	sta	CTLORD		;save

	ret

;******==============================
;* WS *   Write Sector (0-9)
;****** 
; On Entry:
;    b = desired sector number
;   (de) = Memory address
; On Exit:
;   clobbers all
;====================================
NSWRIT:	jz	BADINP		;no parameter specified
	lda	NBSTAT		;check for write protect
	ani	NSWP
	jnz	WPERR

; Issue a controller order to set/clear write precomp based
;   on the track number

NSSKPC:	lda	CTLORD		;put current order in l
	mov	l,a

	lda	DRVSIZ		;compute precomp track 
	adi	4		;40->44, 80->84, carry cleared
	rar			;22 or 42
	mov	c,a		;c=precomp track

	lda	CRTRAK		;at or above precomp track #?
	cmp	c
	jc	NSNPC		;track<precomp, no precomp needed

	mov	a,l		;turn on precomp bit (not saved)
	ori	NPREON
	mov	l,a		;l=controller order

NSNPC:	mvi	h,NORDER/256	;h=msb of controller order address
	mov	a,m		;issue order with precomp bit

	call	NSETUP		;set up for read/write

;wait for controller to be ready to write the sector

	lda	NWRCRD		;issue write command to controller

NSWR1:	lda	NASTAT		;wait for pre-sector window to pass
	ani	NSWIND
	jnz	NSWR1

;write sector header

	lxi	b,NWRITE	;c=0,b=write prefix
	lxi	d,001FH		;e=number of header zeros (31)
				;d=init CRC calculation

NSWR2:	ldax	b		;write a zero
	mov	a,a		;kill some time
	mov	a,a		;kill some time
	dcr	e		;count header zeros
	jnz	NSWR2

;write two sector sync characters

	mvi	c,SYNC		;write sync chr
	ldax	b
	mov	a,a		;kill some time
	mov	a,a		;kill some time
	mvi	c,SYNC		;kill some time
	ldax	b		;write 2nd sync

;write  sector data 2 bytes at a time (512 bytes)

NSWR3:	mov	c,m		;get byte from RAM
	mov	a,c		;Calculate CRC
	xra	d		;keep it in d
	rlc
	mov	d,a
	ldax	b		;write chr to disk
	inx	h		;bump pointer

	mov	c,m		;get chr from RAM
	mov	a,c		;Calculate CRC
	xra	d		;keep it in d
	rlc
	mov	d,a
	ldax	b		;write chr to disk
	inx	h		;bump pointer

	dcr	e		;write 256*2 bytes
	jnz	NSWR3

;write sector CRC

	mov	c,d		;Write CRC
	ldax	b
	
	ret			;don't wait for end of sector

;******============================
;* SK *   Seek Track (0-39 or 0-79 decimal)
;****** 
; On Entry:
;    b = desired track
; On Exit:
;    CRTRAK = current track
; trashes all registers
;==================================
NSSEEK:	jnz	SKTRAK		;track param present, do seek

	call	CILPRT
	db	'On track',' '+80h

	lda	CRTRAK		;a=current track number
	ora	a
	jm	SKNOTK		;msb set=track undefined

	mov	b,a		;otherwise, display track number
	jmp	DSPDEC

SKNOTK:	call	ILPRNT
	db	'unknow','n'+80h
	ret

SKTRAK:	lda	DRVSIZ		;a=tracks on drive
	dcr	a		;a=max track number
	cmp	b		;max track - desired track
	jc	BADINP		;too large

	mov	l,b		;save track number

	call	NSELCT		;select drive, spin up

	lda	CRTRAK		;where are we?
	ora	a		;0FFh means we don't know
	cm	NSRSTR		;lost: restore

;compute the required number of steps and the direction

	sub	l		;which way to step?
	rz			;already there?

	mvi	e,NSTPOUT	;e=step direction, assume out for now
	jp	SKOUT		;current>desired, seek out

	mvi	e,NSTPIN	;desired<current, seek in
	cma			;compute a=-a
	inr	a

;put number of steps in h, set step direction in e, save target track
;   in CRTRAK then do the steps.

SKOUT:	mov	h,a		;h=number of steps
	mov	a,l		;save what will be the new track
	sta	CRTRAK
	jmp	NSSTEP		;do the seek

;Fall into NSSTEP

;***Subroutine*******************************
; Step Head
; On Entry:
;   h = number of steps, >0
;   e = step direction (NSTPIN or NSTPOUT)
; On Exit:
;   Z set, a=0, and CRTRAK=0 if track 0 found
;   a = 2 otherwise
; trashes psw,b,h
;********************************************
NSSTEP:	push	d		;save de
	lda	CTLORD		;form controller order in e
	ora	e		;e has step in/out bit
	mov	e,a		;e=final controller order

	mvi	d,NORDER/256	;d=MSB of controller order address
	ldax	d		;set step direction

NSSTP1:	mov	a,e		;a=order command
	ori	NSTEPH		;set step line high
	mov	e,a
	ldax	d		;issue step

	mov	a,e		;a=order command
	ani	NSTEPL		;set step line back low
	mov	e,a
	ldax	d		;finish step

	mvi	b,2		;step timer
	call	NSWAIT		;wait 2 sector times

	lda	NBSTAT		;at track 0?
	ani	NSTR0
	jnz	NSSTP2		;yes, stop stepping

	dcr	h		;no, step again
	jnz	NSSTP1		;stepped enough?

	inr	a		;clear Z: not track 0
	pop	d		;restore de
	ret

;on track 0. clear CRTRAK and return with Z set

NSSTP2:	xra	a		;set Z: track 0
	sta	CRTRAK
	pop	d		;restore de
	ret

;***Subroutine******************************
; Set up read or write, then wait for sector
; On Entry:
;    b = desired sector number
;   (de) = target memory address
; On Exit:
;     hl = memory address
;   Z cleared if an error occured
; trashes psw,bc,de
;*******************************************
NSETUP:	mvi	a,MAXSEC	;legal sector?
	cmp	b
	jc	BADINP		;bad sector number

	push	b		;save b=sector	

	call	GETHEX		;get hl=memory address
	jz	BADINP		;address not present

	call	NSELCT		;select drive, spin up

	pop	d		;recover d=desired sector

;Wait for desired sector, following a sector pulse

NSWTS1:	mvi	b,1
	call	NSWAIT		;wait for next sector pulse

	lda	NRSEFL		;reset sector flag (required)
	lda	NCSTAT		;get current sector number
	ani	NSSP		;get sector bits alone
	cmp	d		;the sector we want?
	rz			;yes, return quickly

	jmp	NSWTS1		;no, keep looking

;***Subroutine********************************
; Turn on the motor if necessary, Select drive
; On Entry:
;   CTLORD = order register has desired drive bit set
; trashes psw,bc
;*********************************************
NSELCT:	mvi	b,WRMUP-SETL	;motor warmup time

;long delay if motors are off

	lda	NASTAT		;get current motor status
	ani	NSMO		;already on?
	lda	NMOTRA		;turn on drive motors
	cz	NSWAIT		;no, spin up

;select drive, load head

	mvi	b,NORDER/256	;b=msb of order command address
	lda	CTLORD
	mov	c,a		;c=order register to write
	ldax	b		;select drive

;wait for settling time after head load

	mvi	b,SETL		;head settling time

;fall into NSWAIT to stall

;***Subroutine***********************
; Wait for b sectors
; On Entry:
;   b = number of sectors to wait for
; trashes psw,b
;************************************
NSWAIT:	lda	NRSEFL		;reset sector flag
	lda	NMOTRA		;restart motor timeout	

NSWAT1:	lda	NASTAT		;get status a
	rlc			;test NSSF, sector flag set?
	jnc	NSWAT1		;no

	dcr	b		;wait for b sectors to pass
	rz

	jmp	NSWAIT


;***Subroutine**************************************
; Time sectors
; On Entry:
;   a = number of sectors to time
; On Exit:
;    b,hl = total number of passes
;           where each pass is 50 CPU cycles
;
;Timing in this subroutine: (8080 cycles)[Z80 cycles]
; Trashes psw,c,de
;****************************************************
TIMSEC:	mov	c,a		;save no. of sectors

;Wait for initial sector
	lda	NRSEFL		;reset sector flag
	lda	NMOTRA		;restart motor timeout	

NSTLP0:	xra	a		;(4)[4](stall)
	dad	d		;(10)[11]bump timer (stall)
	adc	b		;(4)[4]catch carry bit(stall)
	mov	b,a		;(5)[4]b=high byte(stall)

	lda	NBSTAT		;(13)[13]sector number and flag
	ora	a		;(4)[4]wait for valid sector
	jp	NSTLP0		;(10)[10]NSSP is bit 7

;set up timer and timer incrementer. Match time outside loop below.

	mvi	b,0		;(7)[7]clear MSB of timer
	lxi	h,0		;(10)[10]clear rest of timer
	lxi	d,1		;(10)for incrementing
	lxi	d,1		;(10)stall

;time b sectors using c,hl as the timer

NSTLP2:	lda	NRSEFL		;(13)[13]reset sector flag

NSTLP1:	xra	a		;(4)[4]
	dad	d		;(10)[11]bump timer (de=1)
	adc	b		;(4)[4]catch carry bit
	mov	b,a		;(5)[4]b=high byte

	lda	NBSTAT		;(13)[13]sector number and flag
	ora	a		;(4)[4]wait for valid sector
	jp	NSTLP1		;(10)[10]NSSF is msb

;inner loop: 50 cycles per spin

	nop			;(4)[4]stall
	xra	a		;(4)[4]
	dad	d		;(5)[6]make up for time outside loop
	adc	b		;(4)[4]catch carry bit
	mov	b,a		;(5)[4]b=high byte

	dcr	c		;(5)[4]next sector
	jnz	NSTLP2		;(10)[10]

;exactly 50 cycles outside the inner loop [49 for Z80]

;b,hl = total cycles
;time/revolution (uS) = ((b,hl*50)/5)/CPU speed (MHz)
;time/revolution (uS) = (b,hl*10)/CPU speed (MHz)

	ret

;***Subroutine***********************************
; Print b,hl/de in decimal on the console, and
; compute result in binary in QOTENT
; On Entry:
;   (b,hl)=Dividend
;   de=divisor
;   a = number of digits after decimal point
; On Exit:
;   QOTENT = result in binary
; Trashes all registers
;************************************************
DIVIDE:	mvi	c,5		;digit counter

	push	h		;initialize quotent
	lxi	h,0
	shld	QOTENT
	pop	h

DDLOOP:	push	psw		;save decimal point place
	push	b		;save digit count

;Print decimal point if it's the right place

	cmp	c		
	mvi	c,'.'
	cz	PRINTC

;compute & print one ASCII digit: c=((b,hl)/de)+'0'
;and compute b,hl = remainder X 10

	call	DECDIG		;compute/print digit

;compute binary partial result in QOTENT

	push	h
	push	d

	lhld	QOTENT		;multiply result so far by 10
	mov	d,h
	mov	e,l
	dad	h		;X2
	dad	h		;X4
	dad	d		;X5
	dad	h		;X10

	mov	a,c		;de-ASCII digit
	sui	'0'
	mov	e,a
	mvi	d,0		;de=new digit in binary
	dad	d		;add in new digit

	shld	QOTENT		;binary result so far

	pop	d
	pop	h

	mov	a,b		;remainder high byte
	pop	b		;recover c=digit count
	mov	b,a		;but keep new high byte

	pop	psw		;decimal point place

;see if we've done enough digits

	dcr	c
	jnz	DDLOOP

	ret

;---Local Subroutine--------------------------------
; Divide hl by bc and print 1-digit result
; On Entry:
;   (b,hl)=Dividend
;   de=-(divisor)
; On Exit:
;   Quotent has been printed in decimal
;   (b,hl)=remainder X 10
;   c=current digit of quotent in ASCII
; trashes psw
;---------------------------------------------------
DECDIG:	mov	a,b		;a=dividend high byte
	lxi	b,0FF00h+'0'-1	;init c=ASCII quotient
				;..(will go 1 too many)
				;create b=MSB of divisor

;divide a,hl by (b,de). The result will be an ASCII number
;in c, The remainder will be 16 bits on the stack

	push	h		;set up stack

DIGLP:	inx	sp		;chuck stack value
	inx	sp		;pop to garbage
	push	h		;remember prior result
	inr	c		;bump quotent
	dad	d		;add a negative number
	adc	b		;catch carry bit
	jc	DIGLP

	pop	h		;hl=remainder

; c = quotent in ASCII, hl = remainder in binary
; Compute (b,hl) := hl X 10 (could be 19 bits)

	push	d
	mov	d,h		;temp save X1
	mov	e,l

	xra	a
	mov	b,a

	dad	h		;X2
	adc	b		;b=0: catch carry

	dad	h		;x4
	adc	a		;MSB
		
	dad	d		;x5
	adc	b		;b=0: catch carry

	dad	h		;X10
	adc	a		;MSB

	mov	b,a		;(b,hl) = remainder X 10

	pop	d
	
;fall into PRINTC to print quotent digit in c

;***Subroutine*******************
; Print character in c on console
; trashes psw
;********************************
PRINTC:	mvi	a,CONOUT

; fall into GOBIOS

;***Subroutine**********************
; Go call a BIOS driver directly
; On Entry:
;   c=value for BIOS routine, if any
;   a = BIOS call address offset
; On Return:
;   psw as BIOS left it
;   all other regs preserved
;***********************************
GOBIOS:	push	h
	push	d
	push	b

	call	DOBIOS

	pop	b
	pop	d
	pop	h
	ret

;***Subroutine**********************
; Go call a BIOS driver directly
; On Entry:
;   c=value for BIOS routine, if any
;   a = BIOS call address offset
; On Return:
;   all regs as BIOS left them
;***********************************
DOBIOS:	lhld	WBOOTA		;get BIOS base address
	mov	l,a		;a has jump vector

	pchl			;'call' BIOS routine

;*********************************
; Disk Error Reporting Subroutines
;*********************************
STUCK0:	call	CILPRT
	db	'Track 0 stuc','k'+80h
	jmp	CPROC		;repair stack & quit

NOSYNC:	call	CILPRT
	db	'No syn','c'+80h
	ret

WPERR:	call	CILPRT
	db	'Write protec','t'+80h
	ret


;***Subroutine******************************
;Display value in b as one or two decimal
;   digits (0-99 only)
; On Exit:
;   Trashes psw,b,c
;*******************************************
DSPDEC:	mvi	c,'0'-1		;c contains 10's result in ASCII
	mov	a,b		;a=value to convert

DD10LP:	inr	c		;count 10's
	sbi	10
	jnc	DD10LP

	adi	10+'0'		;compute 1's digit in ASCII
	mov	b,a		;save in b
	
	mov	a,c		;leading zero in 10's digit?
	cpi	'0'
	cnz	PRINTC		;no, print 10's digit
	
	mov	c,b		;print ones digit
	jmp	PRINTC

;***Subroutine******************************
;Test for Quit abort from user
; On Exit:
;   a=0 and Z set if no chr
;   Z clear and a=input chr if there was one
;*******************************************
TESTQ:	mvi	a,CONST
	call	GOBIOS
	ora	a		;any chr waiting?
	rz			;N: ret with z set

	mvi	a,CONIN
	call	GOBIOS		;get the chr

	cpi	'A'		;letter?
	rc			;n: done

	ani	5fh		;strip parity, make upper case

	cpi	'Q'

	rnz			;z cleared

;fall into ABORT

;*********************
;Abort EPROM operation
;*********************
ABORT:	jmp	CPROC

;============================
; RAM Variables
;============================
CRTRAK:	ds	1	;current track, <0 means lost
CRUNIT:	ds	1	;current unit (must follow CRTRAK)
CTLORD:	ds	1	;current controller order value
DRVSIZ:	ds	1	;drive tracks, 40 or 80
QOTENT:	ds	2	;Binary quotent result
	ds	80	;40-deep stack
STACK:

	END
