;CRTXEB.LIT - certify XYBEC 1410 and 1410A alpha micro systems
;MODIFIED CODE TO WORD WITH AM1000-1500-2000
;WILL PRODUCE A DISK THAT WILL FORMAT TO HIDDEN SECTOR AND BOOT IF USING 
;XEBEC 1410 OR 1410A CONTROLLER
;created 04-24-87 sef  1.3B(100)
;
	SEARCH	SYS
	SEARCH	SYSSYM
	RADIX	16.
	EXTERN	$INMFD,$ADPPN,$PAMFD
	OBJNAM	CRTXEB.LIT

VMAJOR=1.
VMINOR=3.
VSUB=2.
VEDIT=100.
VWHO=0.

;Xebec type 0000 commands
DRVRDY	=	0			; drive online & ready
RECAL	=	1			; recalibrate to track 000
ERR	=	2			; retrieve error code
RSENSE	=	3			; request sense status
FORMAT	=	4			; format drive
REED	=	8.			; read sector from disk and pass data
RDVFY	=	9.			; read verify read sector don't pass data
WRIT	=	10.			; write sector to disk
INITL	=	12.			; initialize controller
SEEK	=	13.			; seek to specific track

;           XEBEC 1410A DEVICE CONTROL BLOCK (DCB)
; byte 0  bits 0-4 = command opcode
; byte 0  bits 5-7 = command class
; byte 1  bit 5 = logical unit number
; uses 21 bit addressing (2,097,151 max)
; byte 1  bit 0-4 = high address     (16-20)
; byte 2  bit 0-7 = middle address   (8-15)
; byte 3  bit 0-7 = low address      (0-7)
; byte 4  bit 0-7 = interleave or sector count (block count)
; byte 5  bit 0-7 = control field
;	  bit 7 = retries 0 = none 1 = 4
;	  bit 6 = reread before error correction 0 = no 1 = yes
;	  bit 4 = imbedded servo
;	  bits 0-3 step rate for drive
; status byte 0 = errors
; status byte 1 = 0 command complete

BUSY$	=	2
CMDDON	=	4			; scsi controller command completed
					; read data port completes sequence
GTSTS	=	10			; scsi status byte pending
SENCMD	=	4.			; scsi ready to accept command
GETDAT	=	16.			; scsi ready to transfer data to s100
SENDAT	=	32.			; scsi ready ro receive data from s100

;Controller I/O port offsets

RDSTS	=	0			; status port = read

CTLSEL	=	0			; controller select

RDDATA	=	1			; read data following are true
					; getstat* - getdat* - cmddon*
WTDATA	=	1			; write data / command following true
					;  sencmd* - sendat*
PORT.2	=	2			; interrupt read = off write = on

CTLRST	=	0			; reset to s-100 via RTS (j1-pin 39)

DEVLNK	=	0			; device table link address LWORD
DEVMNT	=	4			; mount flag bit 3 set if mounted
DEVNAM	=	6			; rad50 device name (3 char)
DEVNO	=	8.			; device number
DEVPHY	=	32.			; physical device = 0
EMBSRV	=	2.			; embedded servo

DX.BUF	=	00			; buffer size = 512
DX.DFG	=	04			; device flags
DX.VER	=	0A			; driver version current = 52
DX.PHY	=	0C			; physical block size 512
DX.BLK	=	10			; blocking size = 1
DX.LSZ	=	14			; logical disk size
DX.HAD	=	18			; hardware controller address
DX.INT	=	1C			; hardware interrupt address
DX.BMS	=	20			; logical bitmap size
DX.ALT	=	24			; alternate track table size
DX.VLD	=	38			; winchester driver flag = 0F1C7
DX.RET	=	3A			; # of retries
DX.HED	=	3C			; number of heads
DX.CYL	=	3E			; number of cylinders
DX.SEC	=	40			; number of sectors
DX.ATC	=	42			; number of spare tracks(cylinders)
DX.WIL	=	44			; write interleave
DX.RIL	=	46			; read interleave
DX.NLG	=	48			; number of logicals
DX.PRE	=	4A			; write pre-comp cylinder
DX.WTC	=	4C			; reduced write cylinder
DX.LND	=	4E			; landing zone cylinder
DX.FLG	=	50			; special flags
DX.STP	=	52			; controller step rate
DX.SEL	=	53			; controller select bits
DX.WIN	=	5A			; driver controller ID

.OFINI
.OFDEF	PRAMTR,2			; bit 3 = display track & cylinder
					; bit 4 = soft errors
					; bit 5 = ok to format
.OFDEF	BUFF1,68.
.OFDEF	DDB,D.DDB			; 44 or 68. our ddb
.OFDEF	BUFF2,220.
.OFDEF	PREALO,2			; 18a or 394.
.OFDEF	DEVTAD,4			; 18C or 396.
.OFDEF	BUFF3,22.
.OFDEF	TLBLKS,4.			; 1a6 or 422.
.OFDEF	ALTRKS,4.			; 1aa or 426.
.OFDEF	SOFTER,4.			; 1ae or 430 soft error count
.OFDEF	BLKBAD,4.			; 1b2 or 434 hard error count
.OFDEF	DSKSNO,10.			; 1b6 or 438. dirve serial number
.OFDEF	ALTADD,4			; 1c0 or 448. alternate track memory
.OFDEF	ALTSIZ,4			; 1c4 or 452. size alt track table
.OFDEF	DAT0,1				; 600 or 1536. i/o command
.OFDEF	DAT1,1				; 601 or 1537.
.OFDEF	DAT2,1				; 602 or 1538.
.OFDEF	DAT3,1				; 603 or 1539.
.OFDEF	DAT4,1				; 604 or 1540.
.OFDEF	DAT5,1				; 605 or 1541.
.OFDEF	FF,4				; 606 or 1542.
.OFDEF	BADTRK,4.			; 60a or 1546.
.OFDEF	TOTLTK,4.			; 60E or 1550. total alternate tracks
.OFDEF	STPRTE,1			; 612 or 1554.
.OFDEF	SELCTL,1			; 613 or 1555.
.OFDEF	DRVSEL,1			; DRIVE SELECT
.OFDEF	VMESYS,1			; 
.OFDEF	VME,1
.OFSIZ	IMPSIZ

START:
L0:
	PHDR	-1,PV$RSM!PV$RPD!PV$WPD,PH$OPR
	PUSH	A2			; save filspec
	LEA	A2,START
	MOVW	#-0100,D1		; clear crt
	TCRT	
	MOVW	#014E,D1		; cursor 1,78
	TCRT	
	MOVW	#-0DF,D1		; end reverse video
	TCRT	
	MOVW	#0121,D1		; cursor 1,33
	TCRT	
	MOVW	#-0E0,D1		; start reverse video
	TCRT	
	TYPESP	<C R T X E B >
	MOVW	#-0DF,D1		; end reverse video
	TCRT	
	MOVW	#0101,D1		; cursor 1,1
	TCRT	
	TYPESP	<Version ->
	VCVT	2(A2),OT$TRM		; output version #
	MOVW	#0210,D1		; cursor 2,15
	TCRT
	TTYI
	ASCII	!5 1/4 Winchester/XEBEC  Alpha Micro Certification!
	BYTE	0
	EVEN
	CRLF
	POP	A2			; restore filespec
	GETIMP	IMPSIZ,A5		; local memory for work & var storage
	FSPEC	DDB(A5)			; set up dsk i/o ddb
	LEA	A6,DDB(A5)		; certification for local cpu
	TST	D.CPU(A6)		; only
	BEQ	LOCCPU			; 
	TYPECR	<Program restricted to use on local system only>
	JMP	ENDIT
LOCCPU:
	INIT	DDB(A5)			; & get buffers
	MOV	DEVTBL,A0		; find target device in device table
LOKDEV:
	MOVW	DEVNAM(A0),D7		; get device name
	CMPW	D7,D.DEV+DDB(A5)	; is it target device
	BNE	NXTDEV			; no, check next device entry
	MOVW	DEVNO(A0),D7		; get device #
	CMPW	D7,D.DRV+DDB(A5)	; same ?
	BEQ	DEVFND			; yes
NXTDEV:
	MOV	DEVLNK(A0),A0		; next device table link address
	CMP	A0,#0			; 0 = end of table
	BNE	LOKDEV			; check device name
	TYPECR	<?Device does not exist> ; device not found
	JMP	ENDIT
DEVFND:
	MOV	A0,DEVTAD(A5)		; 
	JMP	MONTED			; bypass mount routein
	MOVW	DEVMNT(A0),D6		; device must be mounted
	AND	#1000,D6		; test bit 12
	BNE	MONTED
	TYPESP	<?Cannot certify>
	PFILE	DDB(A5)			; output lookup device
	TYPECR	< - device not mounted>
	JMP	ENDIT
MONTED:
	TSTW	DEVPHY(A0)		; must be 1st physical disk
	BEQ	MTPHY			; the one with badblk.sys
	TYPESP	<?Cannot certify>
	PFILE	DDB(A5)
	TYPECR	< - not the physical device>
	JMP	ENDIT
MTPHY:
	ORB	#3,D.FLG+DDB(A5)	; 1 rtn on error no exit to monitor
					; 2 bypass printing error messages
	DSKMNT	DDB(A5)			; mount disk
	XORB	#-2,D.FLG+DDB(A5)
	MOV	D.DVR+DDB(A5),A1	; check version number
	CMPW	DX.VER(A1),#80.		; lowest version number supported
	BHIS	OKVER			; version # ok
	TYPE	?
	TYPESP	<The driver for>
	PFILE	DDB(A5)			; output device driver
	TYPECR	< is not compatible wiht this version of CRTXEB>
	TYPECR	<?Program aborted.>
	EXIT
OKVER:
	CMPW	DX.WIN(A1),#071C7	; xebex controller
	BEQ	OKXEB			; is this a supported controller
	TYPE	<?>
	TYPESP	<The controller for>
	PFILE	DDB(A5)
	TYPECR	< is not compatible with this version of CRTXEB.>
	TYPECR	<?Program aborted.>
	JMP	ENDIT
OKXEB:
	TYPECR	<              CAUTION: This program writes to all blocks>
	INIT	DDB(A5)
	MOVW	D.DRV+DDB(A5),D1	; get ddb drive unit #
	MOV	D.DVR+DDB(A5),A1	; driver address
	DIV	D1,DX.NLG(A1)		; convert to physical unit #
	LSLW	D1,#5			; bit 5 = logical unit # (0 or 1)
					; controller supports 2 drives only
	MOVB	D1,DRVSEL(A5)		; save drive select
	CLR	D1
	MOVW	DX.CYL(A1),D1		; # usable cylinders
	ADDW	DX.ATC(A1),D1		; # spare cylinders
	ADDW	#1,D1			; start counting from 1
	MUL	D1,DX.HED(A1)		; # heads
	MUL	D1,DX.SEC(A1)		; # sectors
	MOV	D1,TLBLKS(A5)		; total logical blocks/drive
	MOV	DX.ALT(A1),D1		; alternate track table
					; # words to hold bad tracks
	MOV	D1,ALTSIZ(A5)		; alternate track table size
	GETMEM	ALTADD(A5)		; pointer to alternate track table
	BEQ	OKALT
	TYPECR	<?Insufficient memory for alternate track table>
	EXIT
OKALT:
	SUB	#16.,D1			; header
	DIV	D1,#4			; words/4 = entries
	MOV	D1,TOTLTK(A5)		; save # alternate entries
	MOV	D1,ALTRKS(A5)
	MOVB	DX.SEL(A1),SELCTL(A5)	; controller #
	MOVB	DX.STP(A1),STPRTE(A5)	; step rate
	MOV	DX.HAD(A1),A4		; hardware address = A4
	CALL	SETPAR			; get formatting parameters
	CALL	SETSNO			; get serial #
	JLOCK				; hog computer all other's locked out
	CALL	CTLINT			; initialize controller
	CRLF
	TYPESP	<Begin certification of>
	PFILE	DDB(A5)
	CRLF
	CRLF
	CALL	FMTYN			; should we format drive
	BTST	#5,PRAMTR(A5)		; skip formatting if not set
	BEQ	VERFY
	TYPECR	<Formatting Drive>
	CALL	FMTDRV			; format drive
	CRLF
VERFY:
	TYPECR	<Verifying Contents>
	CRLF
	CALL	VERFY1			; build badblk table at badblk(a5)
	CALL	BLDMFD
	BTST	#0,DX.FLG(A1)		; hidden sector 0
 	BEQ	NOHSEC			; no
	CALL	HIDSEC			; set up hidden sector zero
NOHSEC:
	JUNLOK
	CRLF
	CRLF
	MOV	BLKBAD(A5),D1		; total number of bad blocks
	DCVT	0,OT$TRM		; output to crt and we are done
	TYPECR	< bad blocks detected>
	TYPECR	<Certification complete>
	JMP	ENDIT
HIDSEC:
					; hidden sector = first sector on disk
					; bytes 0-7    header
					; bytes 8-41.  drive info hd,cyl,ect
					; bytes 42-45  byte hash total
	MOV	D.BUF+DDB(A5),A2	; clear our ddb output buffer
	MOVW	#127.,D0		; 256 lwords
	MOV	A2,A6			; 512 bytes
10$:
	CLR	(A6)+
	DBF	D0,10$
	LEA	A6,HIDHED		; hidden sector header
	MOVW	#7,D0			; output 8 bytes 0 - 7
20$:
	MOVB	(A6)+,(A2)+		; output hidden sector header
	DBF	D0,20$
	LEA	A6,DX.VLD(A1)		; location 38H-5C (36 bytes)
	MOVW	#35.,D0			; vld,retries,heads,cyl,sec,atc
30$:
	MOVB	(A6)+,(A2)+		; wil,ril,nlg,prt,wtc,lnd,flg
	DBF	D0,30$			; stp,sel,win
	MOV	D.BUF+DDB(A5),A2	; buffer address
	MOVW	#41.,D0
	CLR	D6			; for bytes 0 - 41 (42 total)
	CLR	D7
40$:
	MOVB	(A2)+,D7		; add all the bytes 
	ADD	D7,D6			; sum = d6
	DBF	D0,40$
	MOV	D6,@A2			; hash total @ 42-45
	MOV	D.BUF+DDB(A5),A2	; ddb buffer address
	CLR	D5			; d5 = hidden sector = 0
	CALL	WRTSEC			; write hidden sector (sector 0)
	RTN
HIDHED:
  	WORD	773.			; 305H
	WORD	772.			; 304H
	WORD	1029.			; 405H
	WORD	3			; 3H
	WORD	0E159
	WORD	01941
	WORD	0001
	WORD	0E159
	WORD	01941
	WORD	0001
	WORD	04E75
	WORD	0A00C
ABORT:	TYPECR	<?Certification incomplete>
	JMP	ENDIT
CTLINT:
 	MOVB	#INITL,DAT0(A5)		; initialize drive characteristics
					; drive parameters in 8 byte block
					; cyl,heads,redwite,precomp,max ecc length
					; c=2 h=1 w=2 p=2 e=1
	CALL	SNDCMD
10$:
	MOVB	RDSTS(A4),D7		; read status port
	ANDB	#CMDDON,D7		; wait for command completion
	BEQ	10$			; 
	MOVW	DX.CYL(A1),D1		; # of useable cylinders
	ADDW	DX.ATC(A1),D1		; # of alternate tracks
	ADDW	#1,D1			; start counting from 1
	CALL	SNDDTA			; send data to controller
	TSTB	VME(A5)
	BEQ	20$
30$:
	MOVB	RDSTS(A4),D7		; check status port
	ANDB	#CMDDON,D7		; wait for command completion
	BEQ	30$
20$:
	MOVB	DX.HED(A1),WTDATA(A4)	; # of heads
	MOVW	DX.WTC(A1),D1		; reduced write current cylinder
	CALL	SNDDTA
	MOVW	DX.PRE(A1),D1		; precomp cylinder
	CALL	SNDDTA
	TSTB	VME(A5)
	BEQ	50$
40$:
	MOVB	RDSTS(A4),D7		; read status port
	ANDB	#CMDDON,D7		; untill controller done and 
	BEQ	40$			; status byte pending
50$:
	MOVB	#0,WTDATA(A4)		; no ecc error correcting
60$:
	MOVB	RDSTS(A4),D7		; read status port
	ANDB	#CMDDON,D7		; untill controller done and 
	BEQ	60$			; status byte pending
	SLEEP	#500.			; stall
	CALL	GETSTS
	TST	D1			; 0 = no error 1 = error
	BNE	INTERR			; initialization error
	RTN
SNDDTA:
	TSTB	VME(A5)			; vme system
	BNE	AM1K
	ROLW	D1,#8			; swap high and low bytes
	MOVB	D1,WTDATA(A4)		; send controller high byte
	ROLW	D1,#8			; swap high & low bytes
	MOVB	D1,WTDATA(A4)		; send controller low byte
	BR	ENDWRT
AM1K:
	ROLW	D1,#8.			; swap high & low bytes
10$:
	MOVB	RDSTS(A4),D7		; check controller status
	ANDB	#CMDDON,D7		; ready for data
	BEQ	10$
	MOVB	D1,WTDATA(A4)		; send high byte
	ROLW	D1,#8.			; swap high & low bytes
20$:	
	MOVB	RDSTS(A4),D7
	ANDB	#CMDDON,D7
	BEQ	20$
	MOVB	D1,WTDATA(A4)		; send low byte
ENDWRT:
	RTN
INTERR:

	TYPECR	<?Error during initialization>
	JMP	ABORT
FMTDRV:
					; ddc controll block
					; byte 1 = drive & high address
					; byte 2 = middle address
					; byte 3 = low address
					; byte 4 = interleave
					; byte 5 = options
	MOVB	#FORMAT,DAT0(A5)	; lets format the drive
	MOVB	DRVSEL(A5),DAT1(A5)	; set drive # and address 0000
	CLRB	DAT2(A5)
	CLRB	DAT3(A5)		; format from address 000
	MOVW	DX.WIL(A1),D7		; write interleave
	MOVB	D7,DAT4(A5)		; 
	BNE	10$
	MOVB	#8.,DAT4(A5)		; if = 0 use interleave = 8
10$:
	MOVB	STPRTE(A5),DAT5(A5)	; step rate seek option
	CALL	SNDCMD			; output format command
20$:
	MOVB	RDSTS(A4),D7		; wait for completion 
	ANDB	#CMDDON,D7		; 
	BEQ	20$
	CALL	GETSTS			; get status bytes
	TST	D1			; 0 = ok 1 = error
	BNE	FMTERR			; format error
	MOVB	#RECAL,DAT0(A5)		; recalibrate to track 000
	CALL	SNDCMD
30$:
	MOVB	RDSTS(A4),D7		; wait for completion
	ANDB	#CMDDON,D7
	BEQ	30$
	CALL	GETSTS			; get status bytes
	TST	D1			; 0 = ok 1 = error
	BNE	CALERR			; calibration error
	RTN
FMTERR:
	TYPECR	<?Format drive error>
	JMP	ABORT
CALERR:
	TYPECR	<?Error during recalibrate>
	JMP	ABORT
VERFY1:
	CLR	D2			; current track
	CLR	D5			; logical sector number
	BTST	#5,PRAMTR(A5)		; was disk formatted
	BNE	DSPTRK			; yes verify all tracks
	TYPESP	<Enter Starting track:>
	KBD	ABORT			; verify only from this track forward
	BYP
	GTDEC				; convert to decimal number d1
	MOV	D1,D2
	MOVW	DX.SEC(A1),D5		; # of sectors
	MUL	D5,DX.HED(A1)		; X # of heads
	MUL	D5,D2			; = logical sector number
DSPTRK:
	MOV	ALTADD(A5),A2		; our bad track table stack
VERTRK:
	BTST	#4,PRAMTR(A5)		; display current track
	BEQ	NOTDSP
	TYPESP	<Current track is:>
	MOV	D2,D1
	DCVT	0,OT$TRM
	CRLF
NOTDSP:
	MOVW	DX.SEC(A1),D3		; # of sectors
	MUL	D3,DX.HED(A1)		; X # of heads = logical sector # for track
	DEC	D3			; number from 0 - end
	INC	D2			; next track
VFYSEC:
	SAVE	D2,D3,D5		; save track
					; track logical sector #
					; drive logical sector #
	CALL	RDLSEC			; read a logical sector
	REST	D5,D3,D2
	BNE	BADSEC			; error  bad sector
NXTSEC:
	INC	D5			; increment next logical sector #
	CMP	D5,TLBLKS(A5)		; compare to total sectors on drive
	BCC	30$			; if = then done
	DBF	D3,VFYSEC		; verify next logical sector this track
	BR	VERTRK			; verify next track
30$:
	RTN
BADSEC:
	CMPB	D1,#018			; correctable data error ?
	BNE	HRDERR			; no
	BTST	#6,PRAMTR(A5)		; flag soft errors as hard
	BNE	HRDERR			; yes ? flag as hard error
	INC	SOFTER(A5)		; yes, increment soft error count
	BR	NXTSEC			; check next sector
HRDERR:
	INC	BLKBAD(A5)		; add 1 to bad block count
	MOV	D5,(A2)+		; output to crt bad block #
	TYPE	<Block>
	MOV	D5,D1
	OCVT	0,OT$TRM!OT$LSP!OT$TSP
	TYPECR	<did not verify>
	CMP	D5,#63.			; cylinder zero ?
	BLOS	BADZRO			; fatal error
	MOV	BLKBAD(A5),D7		; compare bad blocks to max allowed
	CMP	D7,ALTRKS(A5)		; altrks = max allowed
	BHI	BADALT			; > max allowed yes = fatal
	BR	NXTSEC			; check next sector
BADZRO:
	TYPECR	<?Cylinder zero did not certify>
	JMP	ABORT
BADALT:
	TYPECR	<?Device has exceeded maximum number of errors>
	JMP	ENDIT
;read a logical sector into a buffer that means data too (512 bytes/sector)
RDLSEC:
					; ddc controll block
					; byte 1 = drive & high address
					; byte 2 = middle address
					; byte 3 = low address
					; byte 4 = block count
					; byte 5 = seek, step rate option
	MOVW	#1,DAT4(A5)		; set up to read 1 sector
	MOVB	STPRTE(A5),DAT5(A5)	; set step rate seek option
	MOVB	DRVSEL(A5),DAT1(A5)	; get drive select
	MOVB	DAT1(A5),D7		; drive # and high track address
	AND	#0E0,D7			; save only drive # 0 or 1
	SWAP	D7			; in high word byte 3 & 4
	OR	D5,D7			; get drive logical sector address
	MOVB	D7,DAT3(A5)		; store low address
	ROR	D7,#8
	MOVB	D7,DAT2(A5)		; store middle address
	ROR	D7,#8
	MOVB	D7,DAT1(A5)		; store high address & drive #
;	MOVB	#REED,DAT0(A5)		; read track
	MOVB	#RDVFY,DAT0(A5)		; verify track only
	CALL	SNDCMD
;if using rdvfy then no 512 bytes transferred and this code can be erased
;but change above bne 10$ ten execute rdsts this should be faster
;10$:
;	MOVB	RDSTS(A4),D7		; is a status byte pending
;	ANDB	#CMDDON,D7		; 
;	BEQ 	10$			; yes read the status
;	MOVB	RDSTS(A4),D7		; is data pending (our 512 bytes)
;	ANDB	#GETDAT,D7		; no check port again
;	BNE	RDSTAT
;	MOV	#511.,D6		; throw data away
;	TSTB	VME(A5)
;	BNE	15$
;12$:
;	MOVB	RDDATA(A4),(A2)+	; read data into ddb buffer
;	DBF	D6,12$
;	BR	RDSTAT
;20$:
;	MOVB	RDSTS(A4),D7
;	ANDB	#CMDDON,D7
;	BEQ	20$
;	MOVB	RDDATA(A4),(A2)+
;	DBF	D6,20$
30$:
	MOVB	RDSTS(A4),D7		; check for status byte
	ANDB	#CMDDON,D7		; and loop untill ready
	BEQ	30$
RDSTAT:
	CALL	GETSTS			; get status bytes
	TST	D1			; = 0 no error read next sector
	BEQ	RDDONE			; no error return for next sector
	CALL	REQSEN			; read error code
	TST	D1
RDDONE:
	RTN
WRTSEC:
	MOVW	#1,DAT4(A5)		; set up to write 1 sector
	MOVB	STPRTE(A5),DAT5(A5)	; set step rate seek option
	MOVB	DRVSEL(A5),DAT1(A5)	; get drive select
	MOVB	DAT1(A5),D7		; drive # and high track address
	AND	#0E0,D7			; save only drive # 0 or 1
	SWAP	D7			; in high word byte 3 & 4
	OR	D5,D7			; get drive logical sector address
	MOVB	D7,DAT3(A5)		; store low address
	ROR	D7,#8
	MOVB	D7,DAT2(A5)		; store middle address
	ROR	D7,#8
	MOVB	D7,DAT1(A5)		; store high address & drive #
	MOVB	#WRIT,DAT0(A5)		; write sector command
	CALL	SNDCMD
10$:
	MOVB	RDSTS(A4),D7		; controller ready to receive data
	ANDB	#CMDDON,D7		; from host to disk
	BEQ	10$			; loop untill controller ready
	MOV	#511.,D0		; send 512 bytes
	TSTB	VME(A5)
	BNE	30$
20$:
	MOVB	(A2)+,WTDATA(A4)
	DBF	D0,20$
	BR	40$
30$:
	MOVB	RDSTS(A4),D7		; status byte pending ?
	ANDB	#CMDDON,D7		; loop untill byte ready
	BEQ	30$
	MOVB	(A2)+,WTDATA(A4)
	DBF	D0,30$
40$:
	MOVB	RDSTS(A4),D7
	ANDB	#CMDDON,D7
	BEQ	40$
	CALL	GETSTS			; get status
	TST	D1			; 0 = no error
	BEQ	50$
	CALL	REQSEN			; get error into d1
	TST	D1
50$:
	RTN
SNDCMD:
	TSTB	VMESYS(A5)		; check for vme yet ?
	BNE	20$			;  - 1 = check already
	MOVB	#-1,VMESYS(A5)		; flag vmesys as checked
	MOV	SYSTEM,D1		; system attribute and status flag
	PUSH	D1			; save d1
	AND	#4,D1			; am1000 ?
	BNE	10$			; yes done
	MOV	@SP,D1			; get system back into d1
	AND	#40,D1			; 1500 ? (40hex)
	BEQ	10$			; no done
	MOVB	#-1,VME(A5)		; set vme flag
10$:
	POP
20$:

	LEA	A3,DAT0(A5)		; get output bytes
	MOV	#5,D1			; output 6 bytes to controller
CTLRDY:
	MOVB	RDSTS(A4),D7		; controller status
	ANDB	#BUSY$,D7		; controller free
	BNE	CTLRDY			; if not loop untill ready
	MOVB	#DRVRDY,WTDATA(A4)	; test drive ready
	MOVB	#0,CTLRST(A4)		; reset controller
	NOP
	NOP
	MOVB	SELCTL(A5),D7		; get controller # (select 1-8)
	MOVB	D7,CTLSEL(A4)		; send to controller
	ORB	#010,D7			; set controller select bit
	MOVB	D7,CTLSEL(A4)			; select controller
CMDRDY:
	MOVB	RDSTS(A4),D7		; read status
	ANDB	#BUSY$,D7		; check busy
	BEQ	CMDRDY			; loop until ready
	MOVB	#0,CTLRST(A4)		; reset controller
10$:
	MOVB	RDSTS(A4),D7		; read sasi status
	ANDB	#018,D7			; strip to i/o and c/d
	XORB	#8,D7			; xor c/d place in i/o state
	CMPB	D7,#018
	BNE	10$
	TSTB	VME(A5)			; vme system
	BNE	NOVME			; no skip it
VVME:
	MOVB	RDSTS(A4),D7		; read sasi status
	ANDB	#CMDDON,D7		; check MSG command done
	BEQ	VVME			; wait for command to complete
SNDVME:
					; send block of data hardware handshake
	MOVB	(A3)+,WTDATA(A4)	; send command to controller
	DBF	D1,SNDVME
	BR	ENDSND			; skip non vme transfer
NOVME:
					; non vme transfer one byte at a time
	MOVB	RDSTS(A4),D7		; read sasi status
	ANDB	#CMDDON,D7		; chg MSG command done
	BEQ	NOVME			; wait for command to complete
	MOVB	(A3)+,WTDATA(A4)	; send command to controller
	DBF	D1,NOVME			; one byte at a time
ENDSND:
	RTN
GETSTS:
	CLR	D1			; clear error check register
					; completion code 2 bytes
					; 0 = error
					; 1 = 0
	MOVB	RDDATA(A4),D1		; read error code from s100 HA
10$:
	MOVB	RDSTS(A4),D7		; check status port is byte transfered
	ANDB	#1,D7			; yes
	BEQ	10$
20$:
	MOVB	RDSTS(A4),D7		; check status
	ANDB	#CMDDON,D7		; controller free ?
	BEQ 	20$
	MOVB	RDDATA(A4),D2
30$:
	MOVB	RDSTS(A4),D7		; check status
	ANDB	#BUSY$,D7		; controller free ?
	BNE 	30$
	AND	#2,D1			; bit 1 = 1 only if error occured
	RTN
REQSEN:
	MOVB	#RSENSE,DAT0(A5)	; read controller error
	MOVB	DRVSEL(A5),DAT1(A5)	; controller select
;	MOVW	D5,DAT2(A5)		; logical sector # in error
;	CLRB	DAT5(A5)		; controll byte
	ORB	#2,DAT4(A5)
	CALL	SNDCMD
	LEA	A6,BADTRK(A5)		; bad block address
	MOV	#3,D0			; read 4 bytes (0 - 3)
					; byte 0 = error code
					; byte 1-3 = address
	TSTB	VME(A5)			; 
	BNE	30$

10$:
	MOVB	RDSTS(A4),D7		; error data ready ?
	ANDB	#CMDDON,D7		; loop untill ready
	BEQ	10$
20$:
	MOVB	RDDATA(A4),(A6)+	; read byte
	DBF	D0,20$			; untill done
	BR	40$
30$:
	MOVB	RDSTS(A4),D7		; check for status byte pending
	ANDB	#CMDDON,D7
	BEQ	30$			; loop untill ready
	MOVB	RDDATA(A4),(A6)+	; read status byte
	DBF	D0,30$
40$:
	MOVB	RDSTS(A4),D7		; check for command done
	ANDB	#CMDDON,D7
	BEQ	40$
	MOVB	RDDATA(A4),D7		; read completion code
50$:
	MOVB	RDSTS(A4),D7		; check for controller not busy
	ANDB	#1,D7			; controller free ?
	BEQ	50$			; loop untill free
60$:
	MOVB	RDSTS(A4),D7
	ANDB	#CMDDON,D7
	BEQ	60$
	MOVB	RDDATA(A4),D7
70$:
	MOVB	RDSTS(A4),D7
	ANDB	#BUSY$,D7
	BNE	70$
	CLR	D1			; clear work register
					; sense byte = 0
					; bits 0-3 = error code
					; bits 4-5 = error type
					; bit 7 = valid address
	ANDW	#03F,BADTRK(A5)		; save error code & error type only
	MOVW	BADTRK(A5),D7		; 
	ANDW	#0F,D7			; sense byte only
	BEQ	SENOK
	MOVB	BADTRK(A5),D1
SENOK:
	RTN
SETPAR:
	CRLF
	TYPESP	<Enter maximum acceptable number of bad blocks:>
	KBD
	CTRLC	ABORT
	GTDEC
	CMP	D1,ALTRKS(A5)		; cannot be greater than max #
	BLOS	OKALTK			; drive formatted for
	TYPE	<?>			; too many output largest
	MOV	ALTRKS(A5),D1		; number driver can support
	DCVT	0,OT$TRM
	TYPECR	< bad blocks is maximum>
	BR	SETPAR
OKALTK:
	MOV	D1,ALTRKS(A5)
	TYPESP	<Enter number of accounts to preallocate:>
	KBD
	CTRLC	ABORT
	GTDEC
	MOVW	D1,PREALO(A5)
CTRACK:
	TYPESP	<Display current track? (Y or N):>
	KBD
	CTRLC	ABORT
	BYP
	CMPB	@A2,#'N
	BEQ	10$
	CMPB	@A2,#'Y
	BNE	CTRACK
	BSET	#4,PRAMTR(A5)		; display current track
10$:
	TYPESP	<Flag soft errors defective? (Y or N):>
	KBD	ABORT
	BYP
	CMPB	@A2,#'N
	BEQ	20$
	CMPB	@A2,#'Y
	BNE	10$
	BSET	#6,PRAMTR(A5)		; flag soft errors
20$:	
	RTN
SETSNO:
	TYPESP	<Enter serial number (10 char. max.):>
	KBD
	CTRLC	ABORT
	BYP
	MOV	#9.,D7			; 0 to 9 makes 10 characters
	LEA	A3,DSKSNO(A5)		; save drive serial number here
GETSNO:
	CMPB	@A2,#13.		; cr = end of serial number
	BEQ	ENDSN
	MOVB	(A2)+,(A3)+		; move a byte
	DBF	D7,GETSNO		; do it 9 times or cr
	RTN
ENDSN:
	CLRB	(A3)+			; pad unused characters with nulls
	DBF	D7,ENDSN		; untill max 10 characters
	RTN
FMTYN:
	TYPESP	<Format Disk?  (Y or N):>
	KBD	ABORT
	CMPB	(A2),#'N		; no skip formatting
	BEQ	10$
	CMPB	(A2),#'Y		; yes format drive
	BNE	FMTYN
	BSET	#5,PRAMTR(A5)		; ok to format drive
10$:
	RTN
BLDMFD:
					; badblk.sys layout
					; bytes 0-1    next block link
					; bytes 2-3    32773,8005H,[TSM]
					; bytes 4-13   serial number
					; bytes 14-17  hash total 
					; hash total = word sum of all bad blocks
	SAVE	D0,D1,D2,D3,D4,D5,A0,A1,A2,A3,A4,A5
	MOV	D.DVR+DDB(A5),A1	; device driver address
	MOVW	DX.CYL(A1),D5		; calculate total # of usable logical
	ADDW	DX.ATC(A1),D5		; blocks on disk. This number
	MUL	D5,DX.HED(A1)		; multiplied X 512 = disk capacity
	MUL	D5,DX.SEC(A1)		; cyl X hd X sec
	LEA	A2,DNGCYL		; ASCII DIAGNOSTIC CYLINDER 
	CALL	WRTSEC			; write out diagnostic cylinder to disk
	JNE	WRTEND			; error = cannot write to dx cylinder
	LEA	A2,DDB(A5)
	CALL	$INMFD			; initialize a mfd
	JNE	MFDEND			; error = cannot initialize mfd
	MOVW	#0102,D1		; add ppn [1,2]
	CLR	D2
	CALL	$ADPPN			; add [1,2] to our disk
	JNE	PPNEND			; error cannot add ppn
	MOVW	#[BAD],D.FIL+DDB(A5)	; filname
	MOVW	#[BLK],<D.FIL+2>+DDB(A5)	; 
	MOVW	#[SYS],D.EXT+DDB(A5)	; 
	OPENO	DDB(A5)			; open badblk.sys for output
	JNE	BBSEND			; error cannot open
	MOVW	#08005,D1		; 32773. [TSM] ? header
	FILOTW	DDB(A5)			; write word to opened file
	LEA	A1,DSKSNO(A5)		; output our serial #
	MOV	#4,D2			; which is 10 bytes
10$:
	MOVW	(A1)+,D1		; write serial number to drive
	FILOTW	DDB(A5)
	DBF	D2,10$
	MOV	ALTADD(A5),A1		; index badblk area
	MOV	TOTLTK(A5),D2		; Max # of alternate tracks
	ASL	D2,#1			; multiply X 2 = # entries
	DEC	D2			; count from 0
	CLR	D3
20$:
	CLR	D7
	MOVW	(A1)+,D7		; create badblk hash count
	ADD	D7,D3			; which is the sum of all
	DBF	D2,20$			; bad blocks
	MOV	D3,D1			; output low word
	FILOTW	DDB(A5)
	SWAP	D1
	FILOTW	DDB(A5)			; output high word
	MOV	ALTADD(A5),A1		; index badblk area
	MOV	TOTLTK(A5),D2
	ASL	D2,#1
	DEC	D2
30$:
	MOVW	(A1)+,D1		; now output each
	FILOTW	DDB(A5)			; individual bad block
	DBF	D2,30$			; to badblk.sys on disk
	CLR	D1
40$:
	FILOTW	DDB(A5)			; write nulls to remaining
	CMP	060(A5),#01FE		; unused blocks
	BNE	40$
	CLOSE	DDB(A5)			; close badblk.sys file
	JNE	MFDEND
	MOV	#512.,D.SIZ+DDB(A5)	; buffer size
	INIT	DDB(A5)			; init our ddb
	CLR	D1
	MOVW	PREALO(A5),D1		; number of accounts to preallocate
	LEA	A2,DDB(A5)
	CALL	$PAMFD			; allocate extra mfd blocks
	JNE	PAAEND
	DSKMNT	DDB(A5),#MT$PHY		; do a physical mount
	MOV	DEVTAD(A5),A0		; our device table
INTNLG:
	MOV	DEVLNK(A0),A0		; anymore logicals this drive
	MOV	A0,D7
	BEQ	ENDMFD			; 0 = end of table
	MOVW	DEVMNT(A0),D7		; is this device mounted
	ANDW	#8,D7			; all logicals this drive
	BEQ	ENDMFD			; are unmounted (there is no mfd !!!)
	MOVW	DEVNAM(A0),D.DEV+DDB(A5)
	MOVW	DEVNO(A0),D.DRV+DDB(A5)
	CLR	D.FIL+DDB(A5)		; remove badblk.sys
	CLRW	D.EXT+DDB(A5)
	INIT	DDB(A5)
	MOV	#512.,D.SIZ+DDB(A5)
	DSKMNT	DDB(A5)			; mount the disk
	LEA	A2,DDB(A5)
	CALL	$INMFD			; initialize mfd
	MOVW	#0102,D1		; add ppn [1,2]
	CLR	D2
	CALL	$ADPPN			; add [1,2] to our disk
	CLR	D1
	MOVW	PREALO(A5),D1
	CALL	$PAMFD
	BR	INTNLG			; initialize next logical
ENDMFD:
	REST	A5,A4,A3,A2,A1,A0,D5,D4,D3,D2,D1,D0
	RTN
WRTEND:
	REST	A5,A4,A3,A2,A1,A0,D5,D4,D3,D2,D1,D0
	TYPECR	<Unable to write diagnostic cylinder>
	JMP	ENDIT
MFDEND:
	REST	A5,A4,A3,A2,A1,A0,D5,D4,D3,D2,D1,D0
	TYPECR	<Unable to initialize MFD>
	JMP	ENDIT
PPNEND:
	REST	A5,A4,A3,A2,A1,A0,D5,D4,D3,D2,D1,D0
	TYPECR	<Unable to add [1,2] PPN>
	JMP	ENDIT
BBSEND:
	REST	A5,A4,A3,A2,A1,A0,D5,D4,D3,D2,D1,D0
	TYPECR	<Unable to open BADBLK.SYS >
	JMP	ENDIT
PAAEND:
	REST	A5,A4,A3,A2,A1,A0,D5,D4,D3,D2,D1,D0
	TYPECR	<Unable to allocate extra MFD blocks>
	JMP	ENDIT
DNGCYL:
	ASCIZ	/DIAGNOSTICCYLINDER/
	EVEN
	WORD	1343.
	WORD	0
	BLKW	250.			; buffer filler
ENDIT:
	EXIT
	END

.