TITLE	'GBC Disk Test program.'
;	Disk Diagnostic for CompuPro controller
;
;	+-----------------------+
;	|			|
;	|	Disktest	|
;	|			|
;	+-----------------------+
;
;
;	COMPUPRO
;	Oakland Airport
;	Oakland California
;
;	Copyright 1980, Compupro Corporation.
;
;	This product is a copyright program product of
;	COMPUPRO and is supplied for use with the COMPUPRO
;	Disk controllers.
;
;	Version number:	2.2A
;	Version date:	October 27, 1980
;
;	The following code is supplied to customers who
;	purchase a hard/floppy disk system from GBC.
;

VER	=	'2'
LEVEL	=	'2A'

CR	=	0Dh		;ASCII carriage return
LF	=	0Ah		;ASCII line feed
BKSCHR	=	08h		;ASCII baskspace
ABTCHR	=	03h		;ASCII control C
PRMCHR	=	'>'		;prompt char

BDOS	=	0005h		;BDOS jump address
RCO	=	1		;Read console
WCO	=	2		;Write console
RCB	=	10		;Read console (buufered)
GCNS	=	11		;get console status
RDS	=	13		;Reset disk system

TBUFF	=	0080h		;Command line buffer


;	Assembly Constants

DELCNT	=	5000	;Delay count
MTRK	=	76	;maximum track for seek (0-76)=77
MRTRY	=	5	;Maximum retries of r/w op

;	Controller port definitions.

FDPORT	EQU	0C0H		;Base port address for Controller
FDCS	EQU	FDPORT		;Status register
FDCD	EQU	FDPORT+1	;Data register
FDMA	EQU	FDPORT+2	;Dma address (when write)
INTS	EQU	FDPORT+2	;Status Register (when read)

;	Controller function definitions
F.RTK	=	02	;Read track
F.SPEC	=	03	;Specify
F.DSTS	=	04	;Drive status
F.WRT	=	05	;Write data
F.RDAT	=	06	;Read data
F.RECA	=	07	;recalibrate
F.RSTS	=	08	;Read status
F.DRID	=	10	;Read disk identification
F.FMT	=	13	;Format track
F.SEEK	=	15	;Seek

HUT:	=	240/16	;Head unload = 240 ms
SRT:	=	16-8	;Step rate   =   8 ms (stuggart)
HLT:	=	35	;Head load   =  36 ms
ND:	=	00	;Set DMA mode
	page
	org	0100h
DSKTST:	JMP	STARTUP

CPYMSG: DB	CR,LF,'Copyright  Sorcim, 1980 '
	DB	VER,'.'
	DW	rev (LEVEL)
	DB	'.'
	DB	CR,LF,'Sorcim Proprietary product.',CR,LF,01Ah
	DC	LF

STARTUP proc
	PUSH	PSW
	PUSH	B
	PUSH	D
	PUSH	H
	LXI	H,0
	DAD	SP
	SHLD	SYSTK		;save system stack

RESTRT:	LDK	SP,STK
	CALL	PARG		;process command args
	LDK	HL,CPYMSG	;copyright message
	CALL	OSTR
	LDK	BC,1500
	CALL	DELAY		;delay message on screen
	LDK	HL,IMSG
	CALL	OSTR		;initial message
	LD	A,ACTDSK	;pass active disk
	CALL	SDRV		;select
	CALL	CERF		;clear all errors
	JMP	DSKTR


;	Here if restart
DSKT1:	LDK	SP,STK
	LDK	HL,IMSG
	CALL	OSTR		;output message

DSKTR:	CALL	RDRV		;reset drive

;	Master loop of Diagnostic
:2:	CALL	GNC		;get next command
	CALL	GOTO		;Go to processor
	JMP	:2		;continue

GOTO:	JMP	[hl]

EXIT:
	MVI	C,RDS		;Reset disk system
	CALL	BDOS
	LHLD	SYSTK
	SPHL
	POP	H
	POP	D
	POP	B
	POP	PSW
	RET			;return to system

SYSTK:	DW	0

IMSG:	DB	CR,LF,LF,LF
	DB	'CompuPro Disk Sub-system Diagnostic',CR,LF
	DB	'Version '
	DB	VER,'.'
	DW	rev (LEVEL)
	DB	'.',CR,LF
	DB	'Legal commands for disk test are:',CR,LF
	DB	'0 - Confidence Test.',CR,LF
	DB	'1 - Seek test.',CR,LF
	DB	'2 - Read/Display track,sector.',CR,LF
	DB	'3 - Read test.',CR,LF
	DB	'4 - Write verify read test.',CR,LF
	DB	'5 - Random seek, read/write.',CR,LF
	DB	CR,LF
	DB	'* - Display all controller status bytes.',CR,LF
	DB	'D - Select drive.',CR,LF
	DB	'E - Display and clear error count.',CR,LF
	DB	'F - Format a diskette.',CR,LF
	DB	'H - Help me.',CR,LF
	DB	'R - Restart test.',CR,LF
	DB	'S - Set mode of disk (Single, double).',CR,LF
	DB	'X - Exit back to CPM.',CR,LF
	DC	LF
	page
FMTT:	;Format tracks
;	Exit	Disk reformatted.
	proc
	LDK	A,-1		;force selection
	CALL	SDRV		;Select drive
	CALL	SELFMT		;select mode of disk
	LD	A,COD.N
	STO	A,FMT.N		;set N for format
	MOV	E,A
	LDK	D,0
	LDK	HL,TFGPL
	ADD	HL,DE
	LD	A,[hl]		;get GPL for format
	STO	A,FMT.G		;set into table
	CALL	RDRV		;reset drive

	LDK	HL,VFMTR
	CALL	NLSTR		;verify user is ready
	CALL	GANS
	JC	DSKTR		;if no confirmation
	LDK	HL,TRKDAT
	STO	HL,BUFADR	;reset DMA
	LDK	A,0
	CALL	UFN		;set Ns in table

;	FORMAT track 0 as single.
	LDK	HL,FMTR1
	CALL	IFMT		;issue format

	LD	A,FMT.N
	LDK	HL,TRKDAT+3
	CALL	UFN		;update Ns in table
	CALL	CRLF		;new line
	LDK	C,F.FMT
	LD	A,FMT.N
	OR	A
	JZ	:1		;if NOT MF mode
	LDK	C,F.FMT+40h
:1:	MOV	A,C
	STO	A,FMTRK		;set MF mode
	XOR	A
;	FORMAT rest of disk
:2:	INC	A
	STO	A,CTRK		;set next track
	CALL	UFCHRN		;Update UFCHRN
	LDK	HL,FMTRK
	CALL	IFMT		;issue format
	LDK	A,'F'
	CALL	CONOUT		;indicate new track
	LD	A,CTRK
	CMP	MTRK
	JNZ	:2		;if not done
	LDK	HL,VFMTM
	CALL	NLSTR
	CALL	TREAD
	LDK	HL,FMTC
	CALL	NLSTR
	JMP	OTEC		;display errors

FMTC:	DC	'FORMAT complete.'

VFMTM:	DC	'Validating format.'
VFMTR:	DC	'Confirm ready for format of disk (y).'

FMTR1:	DB	F.FMT
	DB	0	;h,us1,us0
	DB	0	;N
	DB	26	;SC
	DB	1Bh	;128
	DB	0E5h	;filler

FMTRK:	DB	F.FMT
	DB	0	;h,us1,us0
FMT.N	DB	0	; 0, 1, 2,3
FMT.S	DB	0	;26,15,8
FMT.G	DB	0	;36,54,74
	DB	0E5h	;filler

TFGPL:	DB	01Bh,036h,054h,074h
	DB	26,  26,   15,   8
	space	4,10
IFMT:	;Issue format command
;	Entry	HL=FWA of FMT command table
	LDK	B,6
	LDK	C,7
	CALL	EXECT		;format trk 0
	OR	A
	RZ			;if ok
	LD	A,LSTSB+1
	OR	A
	RZ			;if ok
	CMP	2
	JNZ	:3		;if not NO write ring
	LDK	HL,NWRMS
	CALL	NLSTR
	JMP	DSKTR

:3:	LDK	HL,FMERM
	CALL	NLSTR
	JMP	DSKTR

NWRMS:	DC	'Disk doas NOT have write ENABLED.'
FMERM:	DC	'FORMAT error, ABORT.'
	space	4,10
UFCHRN:	;Update C,H,R,N for next format
	proc
	LDK	HL,TRKDAT
	STO	HL,BUFADR
	LD	A,CTRK
	CALL	DOSEEK		;Seek to track
	LDK	HL,TRKDAT
	LD	A,CTRK
;	JMP	UFN
	space	4,10
UFN:	;Update N for format
	proc
	LDK	C,26		;maximum sectors
:2:	STO	A,[hl]		;update track
	LDK	DE,4
	ADD	HL,DE
	DEC	C
	JNZ	:2		;if not done
	RET

TRKDAT:
R	SET	1
	ECHO	26
	DB	0,0,R,0
R	SET	R+1
	ENDM
	page
TCONF:	;Confidence test
	LDK	A,MTRK
	CALL	DOSEEK		;set to max track
	LDK	A,1
	CALL	DOSEEK		;Set to 1st track
	CALL	TWRT		;perform write/read test
	CALL	TSEK		;Perform Seek read test
	CALL	TREAD		;perform read test
	CALL	TRSEK		;perform random seek
	CALL	OTEC		;display error counters
	RET
	space	4,10
TSEK:	;Seek and read test
	proc
	LDK	A,1
	STO	A,ACTSEC	;set beginning sector
	LDK	A,2
:3:	STO	A,CTRK
	CALL	DOSEEK		;perform seek
	CALL	RSEC		;read
	LD	A,CTRK
	MOV	C,A
	LDK	A,MTRK
	SUB	C
	CALL	DOSEEK		;perform seek
	CALL	RSEC		;read data
	LD	A,CTRK
	INC	A
	CMP	MTRK
	JNZ	:3		;if not done
	LDK	HL,TSEKM
	CALL	OSTR
	RET


TSEKM:	DB	CR,LF
	DC	'Seek Test complete.'
CTRK:	DB	0		;current track
	space	4,10
TRSEK:	;Test random seek with read
	proc
	LD	A,MSEC
	STO	A,NSECS		;set to full track
	LDK	A,100
:2:	STO	A,CTRK		;max tries
	CALL	GNRN		;get next track
	STO	A,ACTTRK	;set track
	CALL	RSEC		;read
	CALL	GNRN		;get next random number
	LDK	B,0
	MOV	C,A
	CALL	DELAY		;delay
	LD	A,CTRK
	DEC	A
	JNZ	:2		;if not done
	LDK	HL,TRSEKM
	CALL	OSTR
	RET

TRSEKM:	DB	CR,LF
	DC	'Random Seek, read/write Test complete.'
	space	4,10
TWRT:	;Test writing sectors
;	NOTE: this test takes about 8 minutes to run to
;	completion on a floppy disk.
	proc
	CALL	RDRV		;reset drive
	LDK	A,1
	STO	A,NSECS		;set # of sectors to 1

;	Get test pattern
	LDK	HL,TPAT
	CALL	GNUM		;get test pattern
	LD	A,TPAT
	LD	HL,LSECB
	EX	DE,HL		;length to DE
	LDK	HL,DSKB1
	MOV	C,A

;	Fill write buffer with test pattern
:2:	STO	C,[hl]
	INC	HL
	DEC	DE
	MOV	A,D
	OR	E
	JNZ	:2		;if not done with fill
	LDK	A,0


;	Write track loop
:5:	INC	A
	STO	A,ACTTRK
	STO	A,DSKB1		;set track as first byte
	LDK	HL,TRKM
	CALL	OSTR		;output track message
	LD	HL,ACTTRK
	CALL	NOUT		;output track
	LD	A,ACTSEC
	DEC	A

;	Write sector loop
:6:	INC	A
	STO	A,DSKB1+1	;set sector as 2nd byte
	STO	A,ACTSEC
	LDK	HL,DSKB1
	STO	HL,BUFADR
	CALL	WSEC		;write sector
	LDK	HL,DSKB2
	STO	HL,BUFADR	;set read buffer different
	CALL	RSEC		;now read back

;	Now compare buffers for equal
	LD	HL,LSECB
	MOV	B,H
	MOV	C,L
	LDK	DE,DSKB1
	LDK	HL,DSKB2

:7:	LD	A,[de]
	CMP	[hl]
	JZ	:9		;if equal
;	*** output data error ***
	CALL	WERR		;indicate write error
:9:	INC	DE
	INC	HL
	DEC	BC
	MOV	A,B
	OR	C
	JNZ	:7		;if not done

;	Check for all sectors
	LD	A,MSEC
	MOV	C,A
	LD	A,ACTSEC
	CMP	C
	JNZ	:6		;if not all sectors

;	Check for all tracks
	LDK	A,1
	STO	A,ACTSEC	;reset sector #
	LD	A,ACTTRK
	CMP	MTRK
	JNZ	:5		;if not done
	LDK	HL,TWRTM
	CALL	OSTR
	RET

TWRTM:	DB	CR,LF
	DC	'Write verify read Test complete.'

TPAT:	DB	0F0h
	DC	'Test Pattern is : '

TRKM:	DB	CR
	DC	'Track # - '
	space	4,10
WSEC:	;Write a sector
	proc
	LDK	HL,RTRY
	STO	0,[hl]		;clear retry count
:2:	LD	A,ACTTRK
	CALL	DOSEEK		;seek to track
	LDK	A,F.WRT
	LDK	B,9
	LDK	C,7
	CALL	EXFNC		;issue read
	CMP	40h
	JNZ	:3		;if bad read
	LD	A,LSTSB+1
	CMP	80h
	RZ			;if good read
:3:	CALL	USOFE		;update soft errors
	CMP	MRTRY
	JNZ	:2		;if not max

;	Here on any type of write error
WERR:	PUSH	HL
	LD	HL,WERCNT
	INC	HL
	STO	HL,WERCNT
	POP	HL
	JMP	OERR		;update errors
	space	4,10
TREAD:	;Test reading sectors
	proc
	CALL	RDRV		;reset drive
	LD	A,MSEC
	STO	A,NSECS		;read whole track
	LDK	A,0

:2:	INC	A
	STO	A,ACTTRK
	CALL	RSEC		;read next track
	LD	A,ACTTRK
	CMP	MTRK
	JNZ	:2		;if not done
	LDK	HL,TRDM
	CALL	OSTR
	RET

TRDM:	DB	CR,LF
	DC	'Read test complete.'
	space	4,10
RSEC:	;Read sector
;	Exit	Cbit set if read error
	proc
	LDK	HL,RTRY
	STO	0,[hl]		;clear retry count
:2:	LD	A,ACTTRK
	CALL	DOSEEK		;seek to track
	LDK	A,F.RDAT
	LDK	B,9
	LDK	C,7
	CALL	EXFNC		;issue read
	CMP	40h
	JNZ	:3		;if bad read
	LD	A,LSTSB+1
	CMP	80h
	RZ			;if good read
:3:	CALL	USOFE		;update soft errors
	CMP	MRTRY
	JNZ	:2		;if not max
	LD	HL,RERCNT
	INC	HL
	STO	HL,RERCNT
	CALL	OERR		;update errors
	STC			;indicate error
	RET

RTRY:	DB	0		;retry count
	MVI	C,GCNS
	CALL	BDOS
	OR	A
	JNZ	DSKTR		;if abort

SOFCNT:	DW	0		;Soft error count
SERCNT:	DW	0		;total seek errors
RERCNT:	DW	0		;read error count
WERCNT:	DW	0		;write error count
LSECB:	DW	0		;length of sector
	space	4,10
TRDIS:	;Test read and display
	proc
	LDK	A,1
	STO	A,NSECS
	LDK	HL,TRKN
	LD	A,[hl]
	STO	A,ACTTRK
	CALL	GNUM		;Get track
	JC	:2		;if error
	STO	A,ACTTRK
:2:	LDK	HL,SECN
	LD	A,[hl]
	STO	A,ACTSEC
	CALL	GNUM
	JC	:4		;if error
	STO	A,ACTSEC
:4:	LDK	HL,DSKB1
	STO	HL,BUFADR
	CALL	RSEC
	LDK	HL,DSKB1
	LD	HL,LSECB
	EX	DE,HL		;length
	LDK	HL,DSKB1
	CALL	DMEM		;display buffer
	LDK	HL,TDMSG
	CALL	NLSTR
	CALL	GANS		;get answer
	JNC	TRDIS		;if again
	RET

TDMSG:	DC	'Again ? (y) : '
TRKN:	DB	0
	DC	'Enter track to use : '
SECN:	DB	0
	DC	'Enter sector to use: '
	page
;	Select drive
;	Entry	A= -1, request disk, else use A as disk drive
;	Check for repeat of previous FORMAT, 2**7 on.
SDRV:	proc
	CMP	-1
	JNZ	:2		;If drive known

SDRVA:	LDK	HL,SDRVM
	CALL	NLSTR		;send format request
	MVI	C,RCO		;Read console
	CALL	BDOS
	CALL	NORM
	SUI	'A'
	JM	SDRVA		;if illegal
	CMP	'D'+1-'A'
	JP	SDRVA		;If illegal
:2:	STO	A,ACTDSK	;set active disk
	ADI	'A'
	STO	A,PRMDRV	;set into prompt

;	Try and determine density of device
	CALL	DDTYP		;Determine disk type
	STA	ACTTYP
	JZ	SETDP		;If type determined
	JMP	SELFMT


SDRVM:	DB	'Specify drive (A: - D:)  :',BKSCHR
	DC	BKSCHR
	page
SELFMT:	proc		;Select disk mode format
	LDK	HL,SELMS
	CALL	OSTR
	MVI	C,RCO		;Read console
	CALL	BDOS
	CMP	' '
	JZ	:SFMT1		;if no change
	JC	DSKTR		;if abort
	CMP	'0'
	JM	SELFMT		;If illegal
	CMP	'3'+1
	JP	SELFMT		;If illegal
	SUB	'0'
	RLC
	MOV	C,A
	LD	A,ACTTYP
	ANI	1		;Extract sided bit
	ORA	C
SETDP:	ANI	0FEh		;Remove sided bit
	RLC 			;n*4
	LDK	D,0
	MOV	E,A
	LDK	HL,SELFM
	ADD	HL,DE
	LD	A,[hl] ! STO A,COD.F ! INC HL
	LD	A,[hl] ! STO A,COD.N ! INC HL
	LD	A,[hl] ! STO A,COD.G ! INC HL
	LD	A,[hl] ! STO A,COD.D ! INC HL
	LD	A,COD.N
	MOV	E,A
	LDK	HL,TFGPL+4
	ADD	HL,DE
	LD	A,[hl]
	STO	A,FMT.S
	STO	A,MSEC		;set max sectors/track

;	Now set max sector buffer size
	MOV	A,E
	RLC
	MOV	E,A		;*2
	LDK	HL,BUFLT
	ADD	HL,DE
	LD	A,[hl]
	STO	A,LSECB
	MOV	E,A
	INC	HL
	LD	A,[hl]
	STO	A,LSECB+1	;set buffer length
	MOV	D,A
	LDK	HL,PRMSIZ
	EX	DE,HL
	CALL	CBD4		;convert to decimal

:SFMT1:	LDA	COD.N		;Save format code
	STA	FMT.N
	RET

SELMS:	DB	cr,lf
	DB	'Select Disk format mode (0,1,2,3):',cr,lf
	DB	'0 - 128          2 =  512',cr,lf
	DB	'1 = 256          3 = 1024        '
	DC	PRMCHR

SELFM:	DB	00h,00h,07h,80h
	DB	40h,01h,0eh,0FFh
	DB	40h,02h,1bh,0FFh
	DB	40h,03h,35h,0FFh

BUFLT:	DW	128
	DW	256
	DW	512
	DW	1024
	page
RDRV:	;Reset drive performing on
;	Exit	A = 0, transfer ok
	LDK	HL,1
	STO	HL,ACTTRK	;track to 1
	MOV	A,L
	STO	A,ACTSEC	;set sector = 1
	LDK	A,5
	STO	A,NSECS
	LDK	HL,DSKB1
	STO	HL,BUFADR	;set FWA of load
	LDK	A,0
	STO	A,BUFADE
	LDK	HL,SPEC
	LDK	B,3
	LDK	C,0
	CALL	EXEC		;Specify disk command
	CALL	RCAL		;recalibrate drive 0
	RET


COD.F:	DB	F.RDAT+40h	;Command = read
	DB	0		;hds,ds1,dso
COD.T	DB	1		;C, track 1
	DB	0		;Head
COD.BR	DB	1		;record
COD.N	DB	1		;N=MFM mode 256
COD.FR	DB	22		;EOT
COD.G	DB	0Eh		;GPL, MFM 256
COD.D	DB	0ffh		;DTL, MFM 256
LRCMD	=	*-COD.F
	page
;	Output total error count
;	Exit	Error count cells cleared
OTEC:
	LDK	HL,OTMSG
	CALL	NLSTR
	LDK	HL,OTRD
	CALL	NLSTR
	LD	HL,RERCNT
	CALL	NOUT		;output counter
	LDK	HL,OTWT
	CALL	NLSTR
	LD	HL,WERCNT
	CALL	NOUT		;output write errors
	LDK	HL,OTSK
	CALL	NLSTR
	LD	HL,SERCNT
	CALL	NOUT		;output seek errors
	LDK	HL,OSFE
	CALL	NLSTR
	LD	HL,SOFCNT
	CALL	NOUT		;output soft errors

;	Clear all error counters
CERF:	LDK	HL,0
	STO	HL,RERCNT	;clear read error count
	STO	HL,WERCNT	;clear wrt  error count
	STO	HL,SERCNT	;clear seek
	STO	HL,SOFCNT	;clear soft errors
	RET

OTMSG:	DC	'ERROR counters are: '
OTRD:	DC	'   Read  errors : '
OTWT:	DC	'   Write errors : '
OTSK:	DC	'   Seek  errors : '
OSFE:	DC	'   Soft  errors : '
	space	4,10
USOFE:	;Update soft error count
;	Exit	RTRY updated
	LD	HL,SOFCNT
	INC	HL
	STO	HL,SOFCNT
	LD	A,RTRY
	INC	A
	STO	A,RTRY
	RET
	space	4,10
OERR:	;Output error
;	Entry	STSCNT = number of valid status bytes
;		FNCODE = last function code
	proc
	CALL	CKABT		;check for abort
	PUSH HL ! PUSH DE ! PUSH BC
	LDK	HL,ERMSG
	CALL	NLSTR		;indicate error
	LD	A,FNCODE
	CALL	HOUT		;output in hex
	LDK	HL,STMSG
	CALL	OSTR
	LD	A,STSCNT
	MOV	C,A
	LDK	HL,LSTSB
	INC C ! DEC C
:2:	JZ	:4		;if all done
	LD	A,[hl]		;get status byte
	CALL	HOUT		;output hex
	INC	HL
	DEC	C
	JMP	:2		;loop

:4:	POP BC ! POP DE ! POP HL
	RET

ERMSG:	DC	'  ERROR, Func= '
STMSG:	DC	'Status bytes= '

FNCODE:	DB	0
STSCNT:	DB	0		;number of valid status bytes
	space	4,10
OSTS:	;Output status to terminal
;	Entry	A= status byte
	PUSH	BC
	MOV	B,A	;save status
	STO	A,[de]	;save in table
	INC	DE	;update pointer
	MOV	C,A
	LD	A,OUTF
	OR	A
	JZ	:3	;if no direct output
	MOV	A,C	;status byte
	CALL	HOUT	;output byte in hex
:3:	POP	BC
	RET
	page
;	DDTYP - Determine floppy disk type.
;
;	ENTRY	C = Selected drive.
;
;	Exit	Zbit set = no error
;		A = disk type (0-3)

DDTYP:	MOV	A,C
	ADI	'A'
	STA	NRDYM2		;Set drive into message
	LDK	HL,DSTS
	LDK	B,DSTSL
	LDK	C,0
	CALL	EXECP		;Perform command
	LDK	B,1
	CALL	GCMPS		;Get the one status byte
	ANI	020h		;Mask ready bit
	JNZ	DTYP1		;If drive is ready
	LDK	HL,NRDYM1
	CALL	OSTR
	ORI	0FFh		;Clear zero flag
	RET

DTYP1:	LDA	LSTSB		;Get status byte
	ANI	008h		;Mask TS bit
	RRC
	RRC
	RRC
	STA	ACTTYP		;Save sided flag
	LDK	HL,RECAL	;Do a test seek
	LDK	B,LRECAL
	CALL	MOVETO		;Process command
	RNZ			;If error

	LDK	A,2		;Seek to track two
	CALL	DOSEEK		;Do seek
	RNZ			;If error

	LDK	A,F.DRID
	STA	DRID
DTYP2:	LDK	HL,DRID
	LDK	B,DRIDL
	LDK	C,7
	CALL	EXECP		;Process command
	JZ	DTYP3		;If read valid
	LDA	DRID
	XRI	040h		;Compliment MFM bit
	STA	DRID
	ANI	040h
	JNZ	DTYP2		;If MFM not tried
	ORI	0FFh
	RET

DTYP3:	LDA	LSTSB+6	;Get number of bytes
	ADD	A
	MOV	B,A
	LDA	ACTTYP
	ORA	B		;Combine N with sided flag
	CMP	A		;Set zero flag
	RET

DSTS:	DB	F.DSTS
	DB	0
DSTSL:	=	*-DSTS


DRID:	DB	F.DRID
	DB	0
DRIDL:	=	*-DRID

NRDYM1:	DB	CR,LF,'Drive '
NRDYM2:	DB	'x'
	DC	' not ready.'
	page
;	Execute function
;	Entry	A  = Function code
;		B  = # of bytes to output
;		C  = # of bytes for status
;	Exit	None

EXFNC:	MOV	E,A
	LD	A,COD.F
	ANI	1110_0000b	;high 3 bits only
	OR	E
	STO	A,COD.F		;set code
	LD	A,ACTTRK
	STO	A,COD.T
	LD	A,ACTSEC
	STO	A,COD.BR
	DEC	A
	MOV	E,A
	LD	A,NSECS		;Note, cannot be 0
	ADD	E
	STO	A,COD.FR	;set EOT
	CALL	CKABT		;check for abort
	LDK	HL,COD.F	;FWA of function block

EXECT:	CALL	SDMA		;Set DMA

EXECP:	INC	HL
	LD	A,ACTDSK	;Set drive into command table
	STO	A,[hl]
	DEC	HL

EXEC:	PUSH	BC		;save length
	LD	A,[hl]
	STO	A,FNCODE	;Save last function code
EXEC1:	IN	FDCS
	OR	A
	JP	EXEC1		;if no master ready bit
	LD	A,[hl]		;command byte
	OUT 	FDCD		;to controller
	INC	HL
	DCR	B
	JNZ	EXEC1		;if more bytes
	POP	BC
	MOV	A,C		;# of status bytes+1
	OR	A
	STA	STSCNT
	RZ			;if no status bytes
	MOV	B,C		;# of status bytes
	LD	A,OUTF
	ORA	A
	JZ	INT		;If no direct output
	CALL	CRLF
	LD	A,FNCODE
	MOV	D,B
	CALL	HOUT		;Output function
	MOV	B,D
;	JMP	INT


;	Check for no status function
;	If so, exit without checking DMA
;	Status.
;	Entry	B=  Number+1 of status bytes to
;		    input.
;		HL= Exit address
;	Exit	A=  ST0, status

INT:	IN	INTS
	OR	A
	JP	INT		;if not done


;	Get completion status.
;	Entry	B= # of status bytes to read
GCMPS:
GCS2:	IN	FDCS
	OR	A
	JP	GCS2		;if not ready

;	Read in (B) status bytes
;	ST0,1,2, C,H,R and N

	LDK	DE,LSTSB	;last status bytes
GCS3	IN	FDCS
	OR	A
	JP	GCS3		;if nnt ready
	IN	FDCD		;read status
	STO	A,[de]
	INC	DE		;for next store
	DEC	B		;decrement counter
	JNZ	GCS3		;wait until all done
	LD	A,LSTSB
	ANI	0F8h		;ignore us0,1 bits
	RET

LSTSB:	DB	0,0,0,0,0,0,0
	page
;	Seek to specified Track/Sector
;	Entry	A = track.
;
;	Exit	Cbit set if seek error

DOSEEK:	STO	A,DSEKC+2
	STO	A,ACTTRK
	LDK	A,2
	STO	A,STSCNT
	LDK	HL,DSEKC
	LDK	B,3

MOVETO:	LDK	C,0
	CALL	EXECP		;perform positioning
DSEK2:	IN	INTS
	OR	A
	JP	DSEK2		;if not complete
	LDK	A,F.RSTS
	OUT	FDCD		;request status
	LDK	B,2
	CALL	GCMPS		;read status
	CMP	20h
	RZ			;If on track
	LDA	LSTSB		;Get status from buffer
	ANI	3h		;Mask unit number
	MOV	C,A
	LD	A,ACTDSK
	CMP	C
	JNZ	DSEK2		;If not same unit
	LD	HL,SERCNT
	INC	HL
	STO	HL,SERCNT
	CALL	OERR
	STC
	RET

	space	4,10
RCAL:	;Recalibrate drive
	LD	A,ACTDSK
	STO	A,RECAL+1	;set drive
	LDK	HL,RECAL
	LDK	B,2
	JMP	MOVETO		;process command

DSEKC	DB	F.SEEK
	DB	0
	DB	0

SPEC	DB	F.SPEC
	VFD	4\SRT,4\HUT
	VFD	7\(HLT+1)/2,1\ND
LSPEC	=	*-SPEC

RECAL	DB	F.RECA,0
LRECAL	=	*-RECAL
	space	4,10
SDMA:	;Send DMA to controller
	PUSH	HL	;save user's HL
	LDK	HL,BUFADE
	LDK	E,3
SDMA1:	LD	A,[hl]	;get ext adr
	OUT	FDMA
	DEC	HL	;data is backward in memory
	DEC	E
	JNZ	SDMA1	;if not all 3 bytes
	POP	HL
	RET
	page
PARG:	;Process command line arugments
	proc
	IN	INTS		;free status
	JP	:3		;if no pending int

;	input any hanging status
:2:	IN	FDCS
	OR	A
	JP	:2		;if all done
	IN	FDCD
	CMP	80h
	JNZ	:2		;if not done


;	process any command argument
:3:	LD	A,TBUFF
	OR	A
	LDK	C,-1		;indicate un-initialized
	JZ	:4		;if no arguments
	LD	A,TBUFF+2
	CMP	'A'
	LDK	C,0		;default drive=0
	JM	:4		;if not legal drive
	CMP	'P'+1
	JP	:4		;if not legal drive
	SUB	'A'
	MOV	C,A		;set drive
:4:	MOV	A,C
	STO	A,ACTDSK	;set drive
	CALL	CERF		;clear error flags
	RET
	space	4,10
GNRN:	;Get next random number
;	Exit	A= number
	LDK	HL,RNDV
	LD	A,[hl]
	RLC
	INC	A
	RLC
	RLC
	XRA	[hl]
	STO	A,[hl]
	CMP	1
	JC	GNRN		;if too small
	CMP	MTRK+1
	RC			;if in range
	JMP	GNRN

RNDV:	DB	5Ah		;seed
	space	4,10
;	Delay n milliseconds
;	Entry	BC= length
DELAY:	proc
:1:	LDK	A,DELCNT/26
:2:	DCX	B
	INX	B
	DCR	A
	JNZ	:2		;If 1 millisecond not elapsed
	DEC	BC
	MOV	A,B
	OR	C
	JNZ	:1		;If time interval not elapsed
	RET
	space	4,10
GNC:	;Get command character
;	Entry	None
;	Exit	A= next command character
;		HL=address for command
	proc
	LDK	HL,CMDP
	CALL	NLSTR		;prompt user
:1:	MVI	C,RCO		;get command
	CALL	BDOS
	CMP	' '
	JZ	:1		;if leading blank
	CMP	'0'
	JM	:10		;if not number
	CMP	'9'+1
	JP	:10		;if not number
	CMP	'5'+1
	JP	GNC		;if illegal option
	SUB	'0'
	RLC
	MOV	E,A
	LDK	D,0
	LDK	HL,TNUMC
	ADD	HL,DE
	LD	E,[hl]
	INC	HL
	LD	D,[hl]		;get address in DE
	EX	DE,HL
	RET

CMDP:
PRMSIZ:	DB	'    '
PRMDRV:	DB	'A'
	DC	'>'

;	Here if not number command
;	check for alpha
:10:
	CALL	NORM		;normalize char
	CMP	'*'
	JNZ	:11		;if not Display status
	LD	A,OUTF
	CMA
	STO	A,OUTF		;reset status
	JMP	GNC

:11:	CMP	'?'
	JNZ	:13		;if not help
:12:	LDK	HL,IMSG
	CALL	OSTR
	JMP	GNC		;try again

:13:	CMP	'H'
	JZ	:12		;if help

;	Test for select drive
	LDK	HL,SDRVA
	CMP	'D'
	RZ			;if select drive

;	Test for reset
	CMP	'R'
	JZ	RESTRT		;if restart

;	Test for select
	CMP	'S'
	LDK	HL,SELFMT
	RZ			;if select mode

;	Test for output total errors
	CMP	'E'
	LDK	HL,OTEC
	RZ			;if output errors
	CMP	'X'
	JZ	EXIT		;if exit back to cpm

	CMP	'F'
	LDK	HL,FMTT
	RZ			;if format command


	LDK	HL,DSKT1
	RET

TNUMC:		;Command jump table
	DW	TCONF		;confidence test
	DW	TSEK
	DW	TRDIS
	DW	TREAD
	DW	TWRT
	DW	TRSEK
	page
CKABT:	;Check for abort
;	Exit to master loop if console active
	PUSH	HL ! PUSH DE ! PUSH BC
	MVI	C,GCNS
	CALL	BDOS
	POP BC ! POP DE ! POP HL
	OR	A
	RZ			;if no abort
	MVI	C,RCO		;trash char
	CALL	BDOS
	JMP	DSKTR		;anew
	space	4,10
NORM:	;Normalize character UPPER
	;Entry	A= char
	;Exit	A= normalized char
	CMP	'a'
	RM		;if not lower case
	CMP	'z'+1
	RNC		;if not lower case
	SUI	'a'-'A'
	RET
	space	4,10
HOUT:	;Output hex followed by space
	CALL	HNOUT
	LDK	A,' '
	JMP	CONOUT		;one space

HNOUT:	;Output hex data to terminal
;	Entry	A= byte to output
	MOV	B,A		;save byte
	RRC ! RRC ! RRC ! RRC
	ANI	0Fh
	CALL	OHN		;output high
	MOV	A,B
	ANI	0Fh
	CALL	OHN		;output low
	RET
	space	4,10
;	Output hex nibble.

OHN:	ADI	90h
	DAA
	ACI	40h
	DAA
	JMP	CONOUT
	space	4,10
NLSTR:	;Output newline followed by message
	PUSH	HL
	CALL	CRLF
	POP	HL
;	JMP	OSTR

OSTR:	;Output message to console
;	Entry	HL= FWA of message
	LD	A,[hl]
	OR	A		;check sign bit
	PUSH	AF
	MOV	C,A
	CALL	CONOUT		;output char
	POP	AF
	INC	HL
	JP	OSTR		;if not done
	RET
	space	4,10
GANS:	;Get answer to 'y' question
;	Exit	Cbit set if NO.
	MVI	C,RCO
	CALL	BDOS
	CALL	NORM
	CMP	'Y'
	STC
	RNZ			;if NO confirmation
	CLC
	RET
	space	4,10
CRLF:	;Output new line
;	Must perserve all registers
	LDK	A,CR
	CALL	CONOUT
	LDK	A,LF
	JMP	CONOUT
	space	4,10
O2SP:	;Output 2 spaces
	CALL	OSP
OSP:	;Output one space
	LDK	A,' '
;	JMP	CONOUT
	space	4,10
CONOUT:	;Output character to console
;	Entry	A=character
;	Exit	DE=DE,BC=BC,HL=HL
	PUSH HL ! PUSH DE ! PUSH BC
	MOV	E,A
	MVI	C,WCO
	CALL	BDOS
	POP BC ! POP DE ! POP HL
	RET
	page
NOUT:	;Output decimal number
;	Entry	HL= number
;	Exit	Number sent to console
	LDK	DE,TEMN
	CALL	CBD5
	LDK	HL,TEMN
	CALL	OSTR
	RET

TEMN:	DC	'      '
	space	4,10
;CBD	Convert Binary number to Ascii Decimal 
;		with leading zero suppression.
;	Entry	HL= value to convert.
;		DE-> Fwa to store conversion.
CBD5:
	LK	BC,-10000
	CALL	CBO		;convert Ten-Thousands digit
	CALL	CLZ
CBD4:
CBD:
	LK	BC,-1000
	CALL	CBO		;convert Thousands digit
	CALL	CLZ	;CHECK LEADING ZEROS 
CBD3:	LK	BC,-100 
	CALL	CBO 
	CALL	CLZ 
CBD2:	LK	BC,-10 
	CALL	CBO 
	CALL	CLZ 
	MOV	A,L 
	ADI	'0' 
	STAX	D 
	LK	A,'0' 
	STA	CLZA	;RESET TO IGNORE LEADING ZEROS 
	RET 
	space	4,10
;CBO	Convert ONE digit TO	Decimal HEX 
;	ENTRY	(A) = number 
 
 
CBO:	LK	A,'0' 
	PUSH	DE 
CBO1:	MOV	E,L 
	MOV	D,H 
	INR	A 
	DAD	B 
	JC	CBO1	;IF not DONE 
	DCR	A 
	MOV	L,E 
	MOV	H,D 
	POP	DE 
	RET 
 
 
 
 
;CLZ	Check for leading zeros and if found 
;	change to leading SPACES. 
;	ENTRY	(A) = number 
 
 
CLZ:	MOV	B,A 
	LDA	CLZA 
	CMP	B 
	JNZ	CLZ4	;If 1st Leading digit found 
	LK	A,' ' 
	STAX	D 
CLPLUG:	INC	DE	;plug with RET if no leading spaces
	RET 
 
CLZ4:	MOV	A,B 
	STAX	D 
	INC	DE 
	LK	A,0FFH 
	STA	CLZA	;SET TO IGNORE LEADING ZERO 
	RET 
 
CLZA:	DB	'0' 
	page
DMEM:	;Display memory on console
	proc
;	Display Main loop
;	Display bytes to user.
;	DE= Length
;	HL= FWA

NEWLN	=	16-1	;length of line

	DEC	DE	;length-1 for compute of LWA
	EX	DE,HL
	ADD	HL,DE
	EX	DE,HL	;set lwa
:4:
	MVI	B,8	;8 lines then blank line
:5:
	CALL	CRLF	;ECHO CARRIAGE RETURN/LINE FEED
	MOV	A,H
	SUI	high(DSKB1)
	CALL	HNOUT	;high byte of adr
	MOV	A,L
	CALL	HOUT	;low byte with space following
	CALL	O2SP
	CALL	OSP	;one more space
	PUSH	HL	;save starting adr
	MVI	C,0	;initialize counter
:10:
	PUSH	BC	;save counter
	MOV	A,L
	RRC
	CNC	OSP	;Output space if even byte
	LD	A,[hl]	;Get contents of next memory location
	CALL	HNOUT	;display contents
	CALL	CKABT
	CALL	CDEHL	;check for end of request
	POP	BC
	INR	C	;update counter
	JC	:20	;If end found, output remaining ASCII
	INX	HL	;If more to GO, point to next LOC to display
	MOV	A,L	;Get LOW order bits of NEW Address
	ANI	NEWLN	;check for 16
	JNZ	:10	;If NOT at end of line

;	Now check to see if pad need to align ASCII text
;	C= count of bytes this line
:20:
	MOV	A,C
	ANI	NEWLN
	JZ	:21	;If at end of line
	MOV	L,A	;pad length
:20A:
	MOV	A,L
	INR	L
	ANI	NEWLN
	JZ	:21	;If all done
	CALL	O2SP	;Output two spaces
	CALL	OSP	;output third space
	JMP	:20A	;next

;	Now output the ASCII equivalent of data, filtering
;	out non-displayable characters
:21:
	POP	H	;restore FWA
	CALL	O2SP	;output 2 spaces
	CALL	OSP	;output 3rd space
:22:
	LD	A,[hl]
	ANI	7Fh	;ignore parity for ASCII echo
	MVI	C,'_'	;use for illegal character
	CPI	' '
	JC	:24	;If illegal control character
	CPI	7Fh
	JNC	:24	;If NOT displayable character
	MOV	C,A	;ok character
:24:
	MOV	A,C
	CALL	CONOUT
	CALL	CDEHL
	INX	HL
	RC			;if all done
	MOV	A,L
	ANI	NEWLN
	JNZ	:22	;If not full line

;	Check for output of 128 bytes, if so output ONE
;	blank line
	DCR	B
	JNZ	:5	;If not 128
	CALL	CRLF	;Output blank line
	JMP	:4	;reset counter

CDEHL:	;Compare DE to HL
	MOV	A,D
	CMP	H
	RNZ
	MOV	A,E
	CMP	L
	RNZ
	STC
	RET
	page
GNUM:	;Get number from user
;	Entry	HL-> Current value, followed by
;		prompt message string
;	Exit	Cbit set if no #
;		A= low of #
	proc
	PUSH	HL
	INC	HL
	CALL	NLSTR		;output prompt string
	LDK	A,'('
	CALL	CONOUT
	POP	HL
	PUSH	HL
	LD	A,[hl]
	CALL	HOUT		;output current value
	LDK	A,')'
	CALL	CONOUT
	LDK	A,' '
	CALL	CONOUT		;space
	CALL	RNUM		;read number
	POP	HL
	MOV	A,E
	JC	:5		;if no number
	STO	E,[hl]		;reset
:5:	PUSH	AF		;save flags
	CALL	CRLF
	POP	AF		;flags and low of number
	RET
	space	4,10
RNUM:	;Read number
;	Exit	DE= number
;		Cbit set if illegal or NONE
	proc
	MVI	C,RCB
	LXI	D,TEMB
	CALL	BDOS
	LDK	HL,TEMB+1
	LD	A,[hl]
	OR	A
	STC
	RZ			;if NO data
	MOV	C,A
	INC	HL
:3:	LD	A,[hl]		;next char
	CALL	NORM
	STO	A,[hl]		;replace as UPPER
	INC	HL
	DEC	C
	JNZ	:3		;if not all normalized
	STO	0,[hl]		;set eos
	LDK	HL,TEMB+2
	CALL	NUMBR		;convert number
	RET

TEMB:	DB	30
	DS	30
	space	4,10
;	NUMIN converts a number to its value (garbage results if
;	value exceeds 2**16-1 = 65535).  An optional post-radix
;	may be specified:
;		B	2  Binary
;		Q	8  Octal
;		N	10 Decimal
;		H	16 Hexadecimal
;	If the string contains no explicit radix (last character
;	is not one of the above), the caller may specify the
;	default radix.  The cell NUMBAS should contain Ascii
;	B, Q, or H.  If NUMBAS is not defined, or has another
;	value then N (= decimal) is assumed.   An error is
;	reported if a digit greater than the radix appears, or
;	the radix appears, or if the field is empty.  "Digit" means
;	if the field is empty.  "Digit" means '0'..'9' or
;	'A' .. 'Z'.


;NUMBR	Convert Ascii number to value.
;	Entry	HL-> first character of possible number
;		NUMBAS= default radix specifier.
;			If 2**7 set, pre-radix specified.
;			If NUMBAS not DEFined, decimal assumed.
;	Exit	Cbit set if error
;		DE= result value.
;		HL-> last character of number.
;	Preserves BC.
 
NUMBR:	PUSH	BC 
	PUSH	HL 
	LDK	DE,0 
	MOV	B,D 
	MOV	C,D 
NUMB1:	LD	A,[hl]	;GET NEXT SOURCE Character 
	CMP	'0'
	JC	NUMB2	;If below digits, end of field
	CMP	'9'+1 
	JC	NUMB3	;If decimal digit
	CMP	'a' xor 020h
	JC	NUMB2	;If below alpha, end of field
	CMP	('z'+1) xor 020h
	JNC	NUMB2	;if not alfabetic, end of field
NUMB3:	INC	C	;count "digits"
	INC	HL 
	JMP	NUMB1	;loop thru alphanumerics
 
;	C= length OF number Field 
;	HL-> terminating char
NUMB2:
	DEC	HL
	LD	B,[hl]		;B= last character
	EX	[sp],HL		;stack ^Last, HL-> First
	MOV	A,C 
	OR	A 
	JZ	DEC8		;If empty number, ERROR
	MOV	A,B		;check for post-radix
	DEC	C 
	JZ	NUMB5		;If single digit
	CMP	'b' xor 020h
	JZ	BINN		;If Binary
	CMP	'n' xor 020h
	JZ	DEC		;If Decimal 
	CMP	'q' xor 020h
	JZ	OCT		;If Octal 
	CMP	'h' xor 020h
	JZ	HEX		;If HEX 
NUMB5:
	INC	C 
 

;	Convert Decimal number
DEC:
	MOV	A,C 
	CMP	2 
	JM	DEC4	;ONE digit Conversion 
	JZ	DEC3	;TWO digitS 
	CMP	4 
	JM	DEC2	;THREE digitS 
	JZ	DEC1	;FOUR digitS 
	LDK	BC,10000	;FIVE digit Conversion 
	CALL	DECC 
DEC1:	LDK	BC,1000 
	CALL	DECC 
DEC2:	LDK	BC,100 
	CALL	DECC 
DEC3:	LDK	BC,10 
	CALL	DECC 
DEC4:	LDK	BC,1 
	CALL	DECC 

;	Set exit conditions for GOOD number
DEC5:
	CLC		;clear error indicator
DEC7:
	POP	HL	;reply HL-> Last
	POP	BC 
	RET 
 
;	Set exit conditions for BAD number
DECE:
	POP	BC	;discard DECC return address
DEC8:	STC		;Indicate error in Field
	JMP	DEC7 
 
 
 
 
;	process conversion of Decimal digit
;		BC= unit value
;		HL-> character
;	Exit	to DECE if error
;		DE updated
DECC:
	LD	A,[hl]
	SUB	'0' 
	JM	DECE	;If character below digits
	CMP	9+1
	JP	DECE	;If character above digits
	INC	HL 
	OR	A
	RZ		;If digit = 0
	EX	DE,HL
DECC1:	ADD	HL,BC 
	DEC	A 
	JNZ	DECC1	;If not DONE 
	EX	DE,HL 
	RET 
 



;	Convert Octal number
OCT:
	LD	A,[hl] 
	SUB	'0' 
	JM	DEC8	;If character below digits
	CMP	7+1
	JP	DEC8	;If digit exceeds radix
	OR	E 
	MOV	E,A 
	DEC	C 
	INC	HL	;next digit
	JZ	DEC5	;If all digits processed
	EX	DE,HL 
	ADD	HL,HL 
	ADD	HL,HL 
	ADD	HL,HL 
	EX	DE,HL 
	JMP	OCT 
 


;	Convert Hexadecimal number
HEX:
	LD	A,[hl] 
	CMP	'0' 
	JM	DEC8	;If not number 
	CMP	'9'+1 
	JM	HEX1	;If HEX 
	CMP	'a' xor 020h
	JM	DEC8	;If not number 
	CMP	('f'+1) xor 020h
	JP	DEC8	;If not number 
	SUI	7 
HEX1:
	AND	0Fh
	OR	E 
	MOV	E,A 
	INC	HL
	DEC	C	;decrement digit processed count
	JZ	DEC5	;If all digits processed
	EX	DE,HL 
	ADD	HL,HL 
	ADD	HL,HL 
	ADD	HL,HL 
	ADD	HL,HL 
	EX	DE,HL 
	JMP	HEX 




;	Convert Binary number
BINN:
	LDK	DE,0	;initialize results
BINN1:
	LD	A,[hl]
	SUI	'0'
	JM	DEC8	;If illegal number
	CMP	1+1
	JP	DEC8	;If illegal number
	EX	DE,HL
	ADD	HL,HL	;left shift 1
	OR	L	;add in this bit
	MOV	L,A
	EX	DE,HL
	INC	HL	;next user character
	DEC	C	;count-1
	JNZ	BINN1	;if not all processed
	JMP	DEC5
	page
;	Temporaries and buffer
OUTF:	DB	0	;Console output flag

BUFADR:	DW	0	;lsbs of address
BUFADE:	DB	0

;	Disk access information.
;	This area is organized into the following groups
;		disk drive
;		track number
;		sector number
;		drive type

ACTDSK:	DS	1		;Actual transfer operation
ACTTYP:	DS	1		;Actual disk's type
ACTTRK:	DS	2		;Actual transfer operation
ACTSEC:	DS	1		;Actual transfer operation
MSEC:	DS	1		;Max sectors per track
NSECS:	DS	1		;Actual # of sectors to xfer


	DS	2*30
STK:	DS	0

;	Disk buffer

	ORG	((*+100h)/100h)*100h
DSKB1:	DS	0
DSKB2:	=	*+1024+1	;2nd disk buffer



	END