;
;  Special test format program for the Tarbell
;double density interface. Use this program to
;format disk in double density with incrementing
;sector fill characters. This will force the
;interface to work harder in the data seperator
;area, showing errors based on the pre-comp setting
;used at the time to format the disk. If you find
;a lot of errors showing up when using the dtest.com
;program, use another pre-comp setting, reformat the
;disk using this program, and test using the dtest.com
;program until the errors are minimized. Then reformat
;the disk using dformat.com so the disk will have E5's
;in the sectors. Don't use 'DFRAND' for normal formatting
;of a double density disk.
;
TRUE	EQU	0FFFFH
FALSE	EQU	NOT TRUE
;
; ******* INTERLEAVE SELECT *******
;
TRK1SD	EQU	FALSE		;TRUE IF TRK 1 = SINGLE DEN.
TRK1DD	EQU	TRUE		;TRUE IF TRK 1 = DOUBLE DEN.
TWO	EQU	FALSE		;SKEW OF 2
THREE	EQU	FALSE		;SKEW OF 3
FOUR	EQU	FALSE		;SKEW OF 4
FIVE	EQU	FALSE		;SKEW OF 5
SIX	EQU	TRUE		;SKEW OF 6
SEC52	EQU	FALSE		;TRUE IS USING 52 SEC/TRK.
;
BDOS	EQU	5
WBOOT	EQU	0
CMD	EQU	0F8H
DAL	EQU	CMD+3
WAIT	EQU	CMD+4
WTRACK	EQU	0F4H
SEEK	EQU	11H		;SEEK = 6MS
DMACHK:	EQU	CMD+5		;DMA CHECK
TRACK	EQU	CMD+1
SECT	EQU	CMD+2
ADR0	EQU	0E0H		;DMA CONTROLLER ADDR. REG
WCT0	EQU	0E1H		; "	  "	WORD COUNT
CMND:	EQU	0E8H		; "	"	COMMAND REG
PANEL	EQU	0FFH		;IMSAI FRONT PANEL
RESTORE EQU 	2		;10MS RESTORE CODE
ORG 100H
;
START:	LXI SP,STACK		;SETUP STACK
	LXI D,MSG1
	MVI C,9
	CALL BDOS		;SIGN ON
COMPLT:
	XRA A			;GET A ZERO
	STA  CLATCH		;CLEAR CLATCH TO DRIVE A
	STA  XFER		;CLEAR TO DMA TYPE XFER.
	INR A			;FLAG <> 0, FORMAT ALL THE DISK
	STA FLAG
	LDA CLATCH		;GET THE CURRENT DRIVE AND DENSITY
	ANI 0F7H		;SET BIT 8 = 0 FOR SINGLE DENSITY
	STA CLATCH		; AND SAVE CURRENT DRIVE STATUS
	LXI D,MSG2
	MVI C,9
	CALL BDOS
	MVI C,1			;GET CHAR FROM KB
	CALL BDOS
	ANI 5FH			;MAKE INTO UPPER CASE
	CPI 'Q'			;QUIT?
	JZ  WBOOT		;YES, EXIT TO SYSTEM
	ANI 3			;MAKE UPPER CASE
	DCR A			;MAKE CPM DRIVE NUMBER
	ADD A
	ADD A
	ADD A
	ADD A			;COMPUTE LATCH VALUE FOR DRIVE
	MOV C,A			;SAVE IT IN REG C
	LDA CLATCH		;GET CLATCH VALUE
	ORA C			;SELECT THE DRIVE
	STA CLATCH		;SAVE DRIVE CODE
	LXI D,MSG2B		;POINT TO DMA FORMAT ?
	MVI C,9
	CALL BDOS
	MVI C,1			;GET CONSOLE CODE
	CALL BDOS
	ANI 5FH			;MAKE UPPER CASE
	CPI 'Y'
	JZ DSEL			;IF Y THEN DO FORMAT IN DMA
	STA XFER		;IF N THEN DO FORMAT IN PGDT
	LXI D,MSG4		;4MHZ CPU MSG
	MVI C,9
	CALL BDOS
DSEL:	LXI D,MSG2A		;TRACKS TO FORMAT MESSAGE
	MVI C,9
	CALL BDOS
	MVI  C,1		;GET CONSOLE RESPONSE
	CALL BDOS
	ANI 5FH
	CPI 'A'			;ALL TRACKS?
	JZ START1
	CPI 'S'			;SYSTEM TRACKS?
	JZ SYSTEM
	CPI 'Q'			;QUIT?
	JZ 0			;WARMBOOT
	JMP DSEL		;ERROR, TRY AGAIN
;
;
SYSTEM:	XRA A
	STA FLAG		;SET SYSTEM ONLY
START1:	LDA CLATCH		;GET LATCH VALUE
	OUT WAIT		;SELECT DRIVE
	MVI A,RESTORE
	OUT CMD
	CALL NOTRDY
	MVI D,0			;SET FOR TRACK 0
SLOOP2:	MVI E,1			;SECTOR
	LXI H,BUFF		;DMA BUFFER
	MVI A,0FFH
	MVI B,40
	CALL PUT
	XRA A
	MVI B,6
	CALL PUT
	MVI M,0FCH
	INX H
	MVI B,26		;GAP 1
	MVI A,0FFH
	CALL PUT
SLOOP:	XRA A
	MVI B,6
	CALL PUT
	MVI M,0FEH
	INX H
	MOV M,D			;TRACK
	INX H
	MVI M,0			;SIDE 0
	INX H
	MOV M,E
	INX H
	MVI M,0
	INX H
	MVI M,0F7H
	INX H
	MVI A,0FFH
	MVI B,11
	CALL PUT
	MVI B,6
	XRA A
	CALL PUT
	MVI M,0FBH
	INX H
	MVI B,128
	CALL RAND 		;DATA 128 BYTES
	MOV A,E			;ARE WE ON SECTOR 1
	CPI 1
	JNZ NOT1		;NO, SKIP SPECIAL ID BYTE
	PUSH H			;YES, PUT IN
	DCX H
	DCX H
	MVI M,0DDH		; 'DD' (HEX) = DOUB. DEN CODE
	POP H
NOT1:	MVI M,0F7H
	INX H
	MVI A,0FFH
	MVI B,27
	CALL PUT
	INR E
	MOV A,E
	CPI 27
	JNZ SLOOP
	MVI C,3
SLOOP3:	MVI B,0
	MVI A,0FFH
	CALL PUT
	DCR C
	JNZ SLOOP3
	PUSH D
	CALL DMA		;WRITE THE DISK WITH DMA
	POP D
	IN CMD			;GET STATUS
	ORA A			;TEST
	JNZ ERROR
	INR D
	MOV A,D
	OUT DAL 		;TELL 1791
	MVI A,SEEK
	OUT CMD
	CALL NOTRDY
          
	IF TRK1SD
	MOV A,D
	CPI 2			;TRACK 2 YET?
	JC  SLOOP2		;IF NOT, DO NEXT TRACK
	ENDIF

START2:	LDA CLATCH		;GET THE CURRENT LATCH CONDITION
	ORI 8			;SET BIT 4 = 1 FOR DOUB. DENSITY
	STA CLATCH		; AND SAVE IT
	OUT WAIT		;NOW SET THE HARDWARE LATCH

	IF TRK1DD
	LXI H,STABLE		;POINT TO S.DENSITY TABLE FOR TRK 1
	ENDIF

	IF TRK1SD
	LXI H,TABLE
	ENDIF

	SHLD PTR		;RESET TABLE POINTER
LOOP2:	LHLD PTR		;GET CURRENT BYTE FROM TABLE
	MOV E,M			;SECTOR NUMBER.
	LXI H,BUFF		;DMA BUFFER
	MVI B,30		;GAP 1
	MVI A,4EH
	CALL PUT
LOOP:	CALL PUTZERO
	MVI A,0F5H
	MVI B,3
	CALL PUT
	MVI M,0FEH
	INX H
	MOV M,D			;TRACK
	INX H
	MVI M,0			;SIDE 0
	INX H
	MOV M,E
	INX H
	MVI M,0
	INX H
	MVI M,0F7H
	INX H
	MVI A,4EH
	MVI B,22
	CALL PUT
	MVI B,12
	XRA A
	CALL PUT
	MVI A,0F5H
	MVI B,3
	CALL PUT
	MVI M,0FBH
	INX H
	MVI B,128
	CALL RAND 		;DATA 128 BYTES
	MVI M,0F7H
	INX H
	MVI A,4EH
	MVI B,11
	CALL PUT
	CALL NEXTSECT
WT:	JNZ LOOP
	PUSH H
	LXI H,TABLE
	SHLD PTR
	POP H
	MVI C,3
LOOP3:	MVI B,0
	MVI A,4EH
	CALL PUT
	DCR C
	JNZ LOOP3
	PUSH D
	CALL DMA
	POP D
	IN CMD			;GET STATUS
	ORA A			;TEST
	JNZ ERROR
	LDA FLAG		;ARE WE DOING ALL THE DISK ?
	ORA A			;YES IF NOT = 0
	JZ COMPLT		;NO, JUST FIRST 2 TRACKS IF = 0
	INR D
	MOV A,D
	CPI 4CH+1		;LAST TRACK?
	JZ COMPLT
	OUT DAL
	MVI A,SEEK
	OUT CMD
	CALL NOTRDY
	JMP LOOP2
PUT:	MOV M,A
	INX H
	DCR B
	JNZ PUT
	RET
;
RAND:	LDA NUMB
RAND1:
	INR A
	CPI 0F4H
	JC RANDF
	MVI A,0
RANDF:
	MOV M,A
	INX H
	DCR B
	JNZ RAND1
	LDA NUMB
	INR A
	STA NUMB
	RET
;
PUTZERO:MVI B,9
	XRA A
	CALL PUT
	RET
ERROR:	CMA			;INVERT FOR PANEL LITES
	OUT PANEL		;DISPLAY ERROR CODE
	LXI D,MSG3
	MVI C,9
	CALL BDOS
	JMP COMPLT
MSG1:	DB 'Tarbell Electronics',0DH,0AH
	DB 'Double Density Test Format Program Ver 1.0',0DH,0AH
	db 'Special random sector fill ver of 4-23-80',0DH,0AH

	IF TRK1SD AND NOT SEC52
	DB 'Formats:',0DH,0AH
	DB 'Tracks  0 - 1 = 26 , 128 byte sectors',0DH,0AH
	DB 'Tracks  2 -76 = 51 , 128 byte sectors',0DH,0AH
	ENDIF

	IF TRK1DD AND NOT SEC52
	DB 'Formats:',0DH,0AH
	DB 'Track  0      = 26 , 128 Byte Sectors',0DH,0AH
	DB 'Tracks 1 - 76 = 51 , 128 Byte sectors',0DH,0AH
	ENDIF

	IF TRK1SD AND SEC52
	DB 'Formats:',0DH,0AH
	DB 'Tracks 0 -  1 = 26 , 128 Byte sectors',0DH,0AH
	DB 'Tracks 1 - 76 = 52 , 128 Byte sectors',0DH,0AH
	ENDIF

	IF TRK1DD AND SEC52
	DB 'Formats:',0DH,0AH
	DB 'Track  0      = 26 , 128 Byte sectors',0DH,0AH
	DB 'Tracks 1 - 76 = 52 , 128 Byte sectors',0DH,0AH
	ENDIF

	DB 'Sector Skew of '

	IF TWO
	DB '2'
	ENDIF

	IF  THREE
	DB '3'
	ENDIF

	IF  FOUR
	DB '4'
	ENDIF

	IF  FIVE
	DB '5'
	ENDIF

	IF  SIX
	DB '6'
	ENDIF

	DB 0DH,0AH
MSG2:	DB 0DH,0AH,'Drive ? (A,B,C,D)  or Q to Quit $'
MSG2A:	DB 0DH,0AH,'Format System or All? (S,A)  $'
MSG2B:	DB 0DH,0AH,'Use DMA for formatting ? (Y or N)  $'
MSG4:	DB 0DH,0AH,'You must have a CPU running at 4 MHz.$'
MSG3:	DB 0AH,0DH,'ERROR- Check for write protected disk',0AH,0DH,'$'
;
;DMA ROUTINE
;
DMA:	LDA XFER	;CHECK FOR DMA FORMAT WANTED
	ORA A		;IS IT ZERO?
	JZ  DMAXFER	;YES, USE DMA FOR FORMATTING
	LXI H,BUFF	;NOPE, USE PROGRAM DATA TRANSFER
	MVI A,WTRACK	;GET WRITE TRACK COMMAND
	OUT CMD		;TELL DISK CONTROLLER
XLOOP:	IN  WAIT	;WAIT TILL INTRQ OR DRQ HAPPENS
	ORA A		;SET FLAGS
	RP		;RETURN IF DONE
	MOV A,M		;GET A BYTE FROM FORMAT BUFFER
	INX H		;BUMP MEMORY POINTER
	OUT DAL		;SEND BYTE TO 1793
	JMP XLOOP	;LOOP FOR MORE DATA
DMAXFER:PUSH H		;SAVE ENDING ADDRESS
	LXI H,BUFF	;POINT TO STORAGE
	MVI A,01H	;SET COMMAND MODE FOR CH 0
	OUT CMND
	MOV A,L		;GET LOW ADDR BYTE
	OUT ADR0	;PUT IT TO DMA CONTROLLER
	MOV A,H		;GET HAGH ADDR BYTE
	OUT ADR0	;PUT IT TO CONTROLLER
	POP H		;RESTORE ENDING ADDRESS
	DCX H		;SET COUNT -1 FOR LENGTH
	MOV A,L		;GET THE LOW BYTE
	OUT WCT0	;PUT IT TO CONTROLLER
	MOV A,H		;GET HIGH BYTE OF COUNT
	ORI 80H		;SET WRITE BIT ON
	ANI 0BFH	;MAKE SURE READ BIT OFF
	OUT WCT0	;AND PUT IT TO CONTROLLER
	MVI A,WTRACK	;SET FOR WRITE TRACK
	OUT CMD		;TELL 1791 ABOUT IT
	MVI A,40H	;DELAY LOOP
DLOOP:	DCR A
	JNZ DLOOP	;LOOP TILL ZERO
NOTRDY:	IN DMACHK	;CHECK INTRQ
	RLC		; BIT 7
	JC NOTRDY	;LOOP TILL NOT BUSY
	RET
NEXTSECT:
	PUSH H
	LHLD PTR
	INX H		;BUMP POINTER
	SHLD PTR	;AND GET NEXT BYTE
	MOV E,M		;SAVE SECTOR NUMBER IN REG E
	MOV A,E		;CHECK FOR END OF TABLE
	POP H
	ORA A		;SET FLAGS
	RET
FLAG:	DB 0
PTR:	DW TABLE
STABLE:
	IF TRK1DD
	DB 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20
	DB 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37
	DB 38,39,40,41,42,43,44,45,46,47,48,49,50,51
	ENDIF

	IF  SEC52
	DB 52
	ENDIF

	DB 0		;TERMINATOR
;
TABLE:
	IF  TWO		;IF SKEW EQUALS 2
	DB 1,27,2,28,3,29,4,30,5,31,6,32,7,33,8,34,9,35,10,36
	DB 11,37,12,38,13,39,14,40,15,41,16,42,17,43,18,44,19
	DB 45,20,46,21,47,22,48,23,49,24,50,25,51,26
	ENDIF

	IF  THREE
	DB 1,18,35,2,19,36,3,20,37,4,21,38,5,22,39,6,23,40
	DB 7,24,41,8,25,42,9,26,43,10,27,44,11,28,45,12,29
	DB 46,13,30,47,14,31,48,15,32,49,16,33,50,17,34,51
	ENDIF

	IF  FOUR
	DB 1,14,27,40,2,15,28,41,3,16,29,42,4,17,30,43,5,18
	DB 31,44,6,19,32,45,7,20,33,46,8,21,34,47,9,22,35,48
	DB 10,23,36,49,11,24,37,50,12,25,38,51,13,26,39
	ENDIF

	IF  FIVE
	DB 1,11,21,31,51,41,2,12,22,32,42,3,13,23,33
	DB 43,4,14,24,34,44,5,15,25,35,45,6,16,26,36
	DB 46,7,17,27,37,47,8,18,28,38,48,9,19,29,39
	DB 49,10,20,30,40,50
	ENDIF

	IF  SIX AND NOT SEC52
	DB 1,49,9,17,25,33,41,2,50,10,18,26,34,42,3,51
	DB 11,19,27,35,43,4,12,20,28,36,44,5,13,21,29
	DB 37,45,6,14,22,30,38,46,7,15,23,31,39,47,8
	DB 16,24,32,40,48
	ENDIF

	IF SIX AND SEC52
	DB 1,49,9,17,25,33,41,2,50,10,18,26,34,42,3,51
	DB 11,19,27,35,43,4,52,12,20,28,36,44,5,13,21
	DB 29,37,45,6,14,22,30,38,46,7,15,23,31,39,47,8
	DB 16,24,32,40,48
	ENDIF

	DB 00
NUMB:	DB 0		;NUMBER FOR SECTOR FILL
CLATCH:	DB 0		;CURRENT HARDWARE LATCH VALUE
XFER:	DB 0		;TYPE XFER FLAG BYTE
	DS 13		;STACK AREA
STACK:	DS 1
BUFF:	DS 1			;FORMAT BUFFER
	END START

