;------------------------------------------------------------------------
;
;		Copyright 2006 Intergraded Logic Systems
;                  Source Code is Copyright Stephen J. Carden
;
;
;			Please do not share this source!
;------------------------------------------------------------------------
;	Low Level Formatter for mio for real.dos v1.0) 
;
;------------------------------------------------------------------------
;                         Real.dos hdfmtmio.com
;			This program is to replace
;		      		hdfmtmio.com
;
;	Code History.     Init design,   November 5, 2005
;
;
;
;
;
;
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;------------------------------------------------------------------------
; Notes: o This source code MAY NOT be placed for download on any BBS's!
;        o "mea" is a macro that loads the address of the first field
;          into the pointer specified by the second field.
;------------------------------------------------------------------------
; Assembler:  MADMAC (tm) ST Cross Assembler (Atari Corp)
;             XASM   st and IBM VERSIONS
;------------------------------------------------------------------------
;=====================================================================

com_file_name:		.macro
;			dc.b   13,"filename.ext",$9b
			dc.b   12,"Hdfmtmio.com",$9b
			.endm

;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; File revision history. Version Number in hex
;
file_ver:		equ   $12
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the Month in dec for the first time this revision 
;was compiled
;
c_month:		equ   10
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the day in dec for the first time this revision 
;was compiled
c_day:			equ   13
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the year in dec for the first time this revision 
;was compiled
c_year:			equ   2012
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Type of compiler used in program
;
; 0 = unknown Compiler
; 1 = xasm
; 2 = mac_65
; 3 = basic
; 4 = compiled basic xl
; 5 = C65
; 6 = Action
;
; We can add more as time goes on!
;
;
;
xasm:			equ	1
mac_65:			equ	2 
basic:			equ	3
basicxl:		equ	4
c65:			equ	5
action:			equ	6

file_compiler:		equ	xasm
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; is this relocatable code ?
; anyother value other than 1 or 2 would be unknown
r..yes:			equ	1
r..no:			equ	2
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Gotta define if it can be relocated
l_relocatable:		equ	r..no
;
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Gotta define if it can be relocated
r..crl:			equ	$7d
r..crlf:		equ	$9b
r..space:		equ	$20

l_frstscreenbyte:	equ	r..space
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; The language the output file is in. 
;
;
; 0	=	Undifined
; 1	=	English
; 2	=	German
;
r..language:		equ	1
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


; MIO registers
; -------------
mio.RAMPAGE	equ	$D1E0	; write ram page address
dain	equ	$D1E1	; HD data input
daout	equ	$D1E1	; HD & printer data out
inputs	equ	$D1E2	; monitor handshake lines
miscout	equ	$D1E2	; several misc outputs (ramdisk, displays, etc)
irqstat	equ	$D1FF	; read IRQ status
setrom	equ	$D1FF	; write ROM bank address
rststro	equ	$D1E0	; strobe reset low (goes high on read of INPUTS)

; Bit definition of INPUTS
; ------------------------
prfault	equ	$10	; printer fault
prbusy	equ	$40	; printer busy
hdcd	equ	$01	; hard disk command/data
hdmsg	equ	$02	; MSG input
hdio	equ	$04	; hard disk input/output control
hdbusy	equ	$20	; hard disk busy line
hdreq	equ	$80	; hard disk request line

; Bit definitions of MISCOUT
; --------------------------
selstro	equ	$10	; select LOW bit...
ramen	equ	$20	; ram enable bit


; Configurable operating parameters
; ---------------------------------
;memkey	equ	$D600	; 16 byte key... indicates if valid...
mio.dridata	equ	$D610	; data table describing disk drive config
			;  +00: First Logical block address (in sectors)
			;  +03: Last+1 Logical block address (in sectors)
			;  +06: Drive number
			;    Bit[2__0] = SCSI/SASI ID if Hard Drive
			;              = Drive number if Reassignment
			;    Bit[7] : 1 = Drive is a Hard Drive
			;    Bit[6] : 1 = Drive is a RAM Disk
			;    Bit[5] : 1 = Reassign to SIO type Drive
			;         if Bit[7__5] = 0, then unassigned
			;  +07: flags (SCSI)
			;    Bit[7__5] = logical unit number
			;    Bit[4] : 1 = SASI type interface (else SCSI)
			;    Bit[3] : 1 = Disk Write Locked flag


mio.prunit	equ	$D654	; Printer device # (0=disable)

dritype	equ	$D680	; data describing each hard drive (for SASI)
			;  +00: Total # cylinders on Hard Drive (MSB,LSB)
			;  +02: Number of Heads on Hard Drive
			;  +03: Cylinder to start reduced write current
			;  +05: Precomp value (usually 0)
			;  +07: ECC burst length (usually $0B)


prirq	equ	$D6C8	; IRQ enable for parallel spooler



; Hard Disk variables
; -------------------
devidx	equ	$D6D0	; current device ID
direct	equ	$D6D1	; read/write direction
loops	equ	$D6D2
unitID	equ	$D6D3	; SCSI bus ID for drive access
LUN	equ	$D6D4	; logical unit number
byxfer	equ	$D6D5	; length of buffer for read/write ops
bloklen	equ	$D6D6	; length of data block
tsec	equ	$D6D8	; 2 bytes -- temp for RAMDISK
comfram	equ	$D6DA	; 6 byte command frame
driptr	equ	$30	; ptr to drive buffer
curpage	equ	$D6FC	; RAMpage shadow
Smisc	equ	$D6FD	; MISCOUT shadow
fieldln	equ	$40C	; field length for filling

zp	equ	$D3
dptr	equ	$d5

tp	equ	$d5
ntp	equ	$d7



			.include	equates
			.include	globals
			.include	macros

	.org $3000

win_start:
header_info:
			.include	header			; this reads info out of the header and displays to screen

;	Entry of format program
;	-----------------------
start
start2	lda	#$60
	sta	start2
	 tsx
	 stx	stack

	jsr	print
	 dc.b	"     MIO Hard Disk Physical Format"
	 dc.b   $9B,$9B,$9B,-1

	jsr	build		; build table containing a list
	lda	curopt		;  of possible controllers
	beq	f.prer
	 jmp	f.somopt
f.prer	jsr	print
	  dc.b	"You must first use configuration menu",$9B
	  dc.b	"to map 'Dn:' to Hard Drives --- Note",$9B
	  dc.b	"that 'Start Sec#' and 'End Sec#' are",$9B
	  dc.b	"initially set after the Hard Drives",$9B
	  dc.b	"are formatted. Press SELECT+RESET.",$9B,-1
	  jmp	abort

f.somopt	jsr	options		; display list of controllers
	jsr	print
	 dc.b	$9B,"Select Hard Drive to Format: ",-1
f.geopt2	jsr	inkey
	cmp	#27
	bne	f.isnoab
f.fabort	 jsr	print
	 dc.b	$9B,$9B,"User Aborted",$9B,$9B,-1
	 jmp	abort
f.isnoab	tax
	sec
	sbc	#'1'
	bcc	f.geopt2
	 cmp	curopt
	 bcs	f.geopt2
	sta	opt		; set unit to be formatted
	txa
	jsr	prch		; print selection #
	jsr	print
	 dc.b	$9B,$9B,-1

	jsr	seram		; set to system RAM to read table
	jsr	sedrive		; search for this drive
	jsr	geparam		; get params from this drive

	ldy	opt
	lda	optIDt,y
	sta	busID		; set unit ID for HD commands
	 lda	optLUNt,y	;  and LUN
	 sta	Unit

	jsr	print
	 dc.b	$9B,$9B,"   ***** Drive Selection *****",$9B,$9B,-1

	jsr	print
	 dc.b	"1.  Adaptec ACB 4000A/4070",$9B
	 dc.b	"2.  Iomega Alpha/Beta Series",$9B
	 dc.b	"3.  XEBEC 1410/1410A, WD 1002-SHD",$9B
	 dc.b	"4.  Seagate Embedded drives",$9B,-1
	jsr	print
	 dc.b	$9B,"Select Your Drive: ",-1

f.inke4	jsr	inkey
	sbc	#'1'
	bcc	f.inke4
	 cmp	#4
	 bcs	f.inke4

	pha
	 adc	#'1'
	 jsr	prch
	 jsr	print
	  dc.b	$9B,$9B,-1
	jsr	yousure		; make sure he is sure...
	pla
	asl
	tax
	lda	f.drtyp+1,x
	pha
	 lda	f.drtyp,x
	 pha
	rts

f.drtyp
	dc.w	adaptecf-1
	dc.w	iomega-1
	dc.w	xebec-1
	dc.w	sea_mfm-1
	dc.w	sea_rll-1
;


;	Build ID/LUN table from 8 drives
;	--------------------------------
build
	lda	#8
	sta	dunit
	jsr	seram		; set to system RAM
	ldy	#0
	sty	curopt
f.unloop
	jsr	unitX		; calc unit #
	lda	mio.dridata+6,x
	bpl	f.nedri1
	 and	#7
	 ldy	curopt
	 sta	optIDt,y
	 lda	mio.dridata+7,x
	 and	#$E0
	 sta	optLUNt,y
	  lda	#0
	  sta	multit,y
f.cnewopt	 dey
	 bmi	f.newopt	; this is first occurance, add...
	  lda	mio.dridata+6,x
	  and	#7
	  cmp	optIDt,y
	  bne	f.cnewopt
	  lda	mio.dridata+7,x
	  and	#$E0
	  cmp	optLUNt,y
	  bne	f.cnewopt
	   lda	#-1
	   sta	multit,y	; indicate at least two drives share HD
	   dec	curopt
f.newopt	 inc	curopt
f.nedri1	dec	dunit
	bne	f.unloop	; to next drive...
	rts
;


;	Display list of controllers to user
;	-----------------------------------
options
	jsr	print
	 dc.b	"    Intf ID LUN Cyln Head Drive #s",$9B
	 dc.b	"    ---- -- --- ---- ---- --------",$9B,-1

	lda	#0
	sta	opt		; show options...
f.optlp	lda	opt
	clc
	adc	#'1'
	jsr	prch
	jsr	print
	 dc.b	" - ",-1
	jsr	seram		; set to system RAM to read table
	jsr	sedrive		; search for ID/LUN drive...
	jsr	geparam		; get drive parameters
	jsr	prinfo		; print an info line...

f.tagain	lda	dunit
	ora	#'0'
	jsr	prch
	jsr	seram
	jsr	csedri		; continue search on drive
	bne	f.neopt		;  not found... advance to next drive

	 lda	mio.dridata+7,x	; Check for consistency of information
	 and	#$10		; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	 cmp	sasif		; sasi flag
	 bne	f.incons		; inconsistant data
	  lda	dritype,x
	  cmp	cyln+1
	  bne	f.incons
	   lda	dritype+1,x
	   cmp	cyln
	   bne	f.incons
	  lda	dritype+2,x
	  cmp	heads
	  bne	f.incons
	lda	#','
	jsr	prch		; print comma, then drive #
	jmp	f.tagain

f.neopt	lda	#$9B
	jsr	prch
	inc	opt
	lda	opt		; loop for next choice
	cmp	curopt
	bne	f.optlp
	 rts

f.incons	jsr	print
	 dc.b	$9B,$9B,$9B
	 dc.b	"Hard Drive is partitioned into",$9B
	 dc.b	"several units, but the units do",$9B
	 dc.b	"not contain consistant data about",$9B
	 dc.b	"the Hard Drive.  The datum that must",$9B
	 dc.b	"be consistant are: Cylinders, Heads,",$9B
	 dc.b	"and Interface type.  Press",$9B
	 dc.b	"SELECT+RESET for configuration menu.",$9B,-1
	jmp	abort
;

;
;=====================================================
;	Format and verify Seagate ST225N
;=====================================================

;	Format Seagate Drive
;	--------------------
sea_mfm
sea_rll
;	sec
;	lda	cyln
;	sbc	#2
;	sta	cyln		; for SEAGATE... subtract 2 cylindars
;	 lda	cyln+1
;	 sbc	#0
;	 sta	cyln+1
;
;	lda	heads		; need cyln * heads * 32
;	sta	mula
;	lda	cyln
;	sta	mulb
;	 lda	cyln+1
;	 sta	mulb+1
;	jsr	multiply	; res = mula * mulb
;	ldx	#5		; now multiply by 32 for total sectors
;..tlop3	asl	res
;	rol	res+1
;	rol	res+2
;	 dex
;	 bne	..tlop3
;
;	sec
;	lda	res
;	sbc	#100
;	sta	res
;	 lda	res+1
;	 sbc	#0		; For SEAGATE subtract 100 sectors for
;	 sta	res+1		;  reassigned blocks
;	lda	res+2
;	sbc	#0
;	sta	res+2
;
;	lda	res
;	sta	nulogblo+2	; set # logical blocks
;	 lda	res+1
;	 sta	nulogblo+1
;	lda	res+2
;	sta	nulogblo

	jsr	setcom
	 dc.b	6		; Seagate Mode Select
	 dc.b	$15,0,0,0,$0C,0

	jsr	hard		; perform hard disk I/O
	 dc.w	modsel		;  buffer is MODSEL
	 dc.w	12		;  bytes
	 dc.b	-1		;  direction
	bpl	f.okhd1
	 jmp	erconfig

f.okhd1	jsr	setcom
	 dc.b	6		; standard format drive
	 dc.b	4,0,0,0,0,0
	jsr	hard		; perform format... no data I/O
	 dc.w	0,0
	 dc.b	0
	bpl	f.okhd2
	 jmp	erformat

f.okhd2	jsr	readcap		; read drive capacity
;	jsr	verify		; verify all logical blocks
	jmp	xformat

				; Mode Select data block
				; ----------------------
modsel	dc.b	0,0,0,8
	dc.b	0
nulogblo
	dc.b	0,0,0		; # logical blocks
	dc.b	0,0,1,0		; block length
;


;
;========================================================
;	Format and Verify Rodime RO 650/652
;========================================================

;	Format a Rodime RO 650 Hard Disk
;	--------------------------------
rodime
	jsr	setcom
	 dc.b	6		; rodime mode select
	 dc.b	$15,0,0,0,25,0
	jsr	hard
	 dc.w	rmodsel
	 dc.w	25
	 dc.b	-1
	bpl	f.rokhd1
	 jmp	erconfig

f.rokhd1	jsr	setcom
	 dc.b	6		; standard format disk
	 dc.b	4,0,0,0,0,0
	jsr	hard
	 dc.w	0,0
	 dc.b	0
	bpl	f.rokhd2
	 jmp	erformat

f.rokhd2	jsr	readcap		; read drive capacity
;	jsr	verify
	jmp	xformat

				; Mode Select data block for Rodime
				; ---------------------------------
rmodsel	dc.b	0,0,0,0
	dc.b	$03,19		; Page 3, page len
	dc.b	0,0,0,0,0,0,0,0,0,0
	dc.b	1,0		; Bytes/sector
	dc.b	0,0,0,0,0,0,0
;


;
;====================================================
;	Format and verify Adaptec ACB-4000
;====================================================

;	Format an Adaptec ACB-4000 Hard Disk
;	------------------------------------
adaptecf
	lda	#-1
	 dc.b $2C
adaptecr	lda	#0
	sta	f.fixed

	jsr	print
	 dc.b	$9B,$9B,"Select stepping mode:",$9b,$9b
	 dc.b	" 0. Nonbuffered (ST506)",$9b
	 dc.b	" 1. Slow buffered (ST4096)",$9b
	 dc.b	" 2. Fast buffered (others)",$9B,$9b
	 dc.b	"Which?",-1

f.wai1	 jsr	inkey
	 cmp	#'0'
	 bcc	f.wai1
	  cmp	#'3'
	  bcs	f.wai1
	pha
	 and	#15
	 sta	f.stepra	; set step rate...
	pla
	jsr	prch
	jsr	print
	 dc.b	$9B,$9B,-1

	ldx	#0
	lda	#$6C
f.filit	sta	f.sdata+20,x	; set data pattern to check...
	 inx
	 bne	f.filit

	 lda	heads
	 sta	f.ahead
	lda	cyln
	sta	f.acyln+1	; set # heads and cylinders
	 lda	cyln+1
	 sta	f.acyln

	lda	#10
	sta	f.tpass		; allow 4 total passes...

	lda	#0
	sta	f.times		; # errors in etable...
	lda	#low f.etable	; set address of error table
	sta	f.eaddr
	 lda	#high f.etable
	 sta	f.eaddr+1

	bit	f.fixed
	bpl	f.remov
	jsr	setcom
	 dc.b	6
	 dc.b	$15,0,0,0,22,0
	lda	#1
	sta	f.fortc
	jsr	hard
	 dc.w	f.modsel
	 dc.w	22
	 dc.b	-1
	jmp	f.adap44

f.remov	jsr	setcom
	 dc.b	6
	 dc.b	$15,0,0,0,24,0
	lda	#2
	sta	f.fortc
	jsr	hard
	 dc.w	f.modsel
	 dc.w	24
	 dc.b	-1

f.adap44	bpl	f.format
	 jmp	erconfig

f.format	jsr	setcom
	 dc.b	6		; initially try an interleave of 2
	 dc.b	4,0,0,0,2,0	; fill with data pattern $6C
	jsr	hard
	 dc.w	0,0		; format standard...
	 dc.b	0
	bpl	f.vtop
	 jmp	erformat

f.vtop	jsr	readcap		; get # blocks on drive... (result is RES)
	 lda	res
	 sta	bycou
	  lda	res+1
	  sta	bycou+1
	  lda	res+2
	  sta	bycou+2
	 jsr	print
	  dc.b	$9B,$9B,"Total blocks to verify: ",-1
	 jsr	prbycou
	 jsr	print
	  dc.b	$9B,-1

	 lda	#0
	 sta	f.fblock+1
	 sta	f.fblock+2	; zero first block # to test
	 sta	f.fblock+3
	 sta	f.terror	; # errors this time around

f.top	sec			; Set # blocks to verify in command
	lda	res		; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	sbc	f.fblock+3
	sta	f.blocks	; # blocks left to test
	 lda	res+1
	 sbc	f.fblock+2
	 sta	f.blocks+1
	 tax
	  lda	res+2
	  sbc	f.fblock+1
	  sta	f.blocks+2
	  bne	f.max		; if >65536, then set max
	 cpx	#$10
	 bcs	f.max
	  lda	f.blocks
	  ldx	f.blocks+1	; get # blocks to test
	  jmp	f.set
f.max	 lda	#0
	 ldx	#$10

f.set	sta	f.nblock+2	; set # blocks to test...
	sta	f.sdata+11
	stx	f.nblock+1
	stx	f.sdata+10
	ora	f.nblock+1
	bne	f.okt
	 jmp	f.done1		; if no blocks... then exit

f.okt	jsr	print
	 dc.b	156,157,"At Block #",-1
	lda	f.fblock+3
	sta	bycou		; Display block number verifying
	 lda	f.fblock+2	; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	 sta	bycou+1
	  lda	f.fblock+1
	  sta	bycou+2
	 jsr	prbycou

	jsr	setcom
	 dc.b	10
	 dc.b	$31,$10
f.fblock	 dc.b	0,0,0,0		; starting block address
f.nblock	 dc.b	0,$80,$00,0	; search 32768 blocks (or whatever is left)
	jsr	hard
	 dc.w	f.sdata		; block
	 dc.w	20+256		; # bytes
	 dc.b	-1		; write
	tax
	and	#6
	bne	f.cksen		; must either be bad sector or MATCH

	clc			; Search failed (all data good)
	lda	f.fblock+3	; -----------------------------
	adc	f.nblock+2	; set next first block...
	sta	f.fblock+3
	 lda	f.fblock+2
	 adc	f.nblock+1
	 sta	f.fblock+2
	lda	f.fblock+1
	adc	#0
	sta	f.fblock+1
	jmp	f.top		; repeat until all tested...

				; Returns error from verify
f.cksen	lda	senseb		; ~~~~~~~~~~~~~~~~~~~~~~~~~
	bmi	f.loblo		; jump if have logical block...
	 jsr	print
	  dc.b	$9B,$9B,"Sense data has no logical block",$9B,-1
	 jmp	abort

f.loblo	lda	senseb+1	; get sector number that failed...
	sta	f.xlat		; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	sta	bycou+2
	 lda	senseb+2
	 sta	f.xlat+1
	 sta	bycou+1
	  lda	senseb+3
	  sta	f.xlat+2
	  sta	bycou

	jsr	print
	 dc.b	156,157,"Defect at #",-1
	jsr	prbycou
	jsr	setcom
	 dc.b	6		; translate logical block address
	 dc.b	$0F		;  to cylindar, offset
f.xlat	 dc.b	0,0,0
	 dc.b	0,0
	jsr	hard
f.eaddr	 dc.w	0		; ptr to error table
	 dc.w	8		;  return 8 bytes...
	 dc.b	0
	and	#2
	beq	f.fix2		; if error, then must calculate prior
	 jsr	print
	  dc.b	" err in header - skipping!",$9B,-1
	  jmp	f.ok4

f.fix2	jsr	print		; Print physical location of error
	 dc.b	"  C=",-1	; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	lda	f.eaddr
	sta	tp
	 lda	f.eaddr+1
	 sta	tp+1
	ldy	#0
	ldx	#2
f.lop1	lda	(tp),y
	sta	bycou,x
	 iny
	 dex
	 bpl	f.lop1
	jsr	prbycou
	jsr	print
	 dc.b	" H=",-1
	ldy	#3
	lda	(tp),y
	sta	bycou
	 lda	#0
	 sta	bycou+1
	 sta	bycou+2
	jsr	prbycou
	jsr	print
	 dc.b	" B=",-1
	ldy	#5
	ldx	#2
f.lop2	lda	(tp),y
	sta	bycou,x
	 iny
	 dex
	 bpl	f.lop2
	jsr	prbycou
	jsr	print
	 dc.b	$9B,-1

	 lda	f.eaddr
	 clc
	 adc	#8
	 sta	f.eaddr
	  lda	f.eaddr+1	; advance ptr to next address...
	  adc	#0
	  sta	f.eaddr+1
	 inc	f.terror	; # errors this pass
	 inc	f.times		; total errors in table
	 bpl	f.ok4
	  jsr	print
	   dc.b	$9B,$9B,"Too many defects",$9B,-1
	  jmp	abort

f.ok4	lda	f.xlat+2
	clc
	adc	#1
	sta	f.fblock+3	; set starting block to 1 beyond
	 lda	f.xlat+1	;  error block...
	 adc	#0
	 sta	f.fblock+2
	  lda	f.xlat+0
	  adc	#0
	  sta	f.fblock+1
	jmp	f.top


f.done1	lda	f.terror	; Pass done, check if any added
	bne	f.p1done	; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	 jsr	print
	  dc.b	$9B,$9B,"Format completed",$9B,-1
f.good	 jsr	readcap
	 jmp	xformat

f.p1done	jsr	print		; Finished pass 1 verify
				; ~~~~~~~~~~~~~~~~~~~~~~
	 dc.b	$9B,"Verify Completed With Errors",$9B,$9B,-1

	jsr	print
	 dc.b	"Reformatting...",-1

	lda	f.eaddr
	sec
	sbc	#low f.etable
	sta	f.ndef+1	; set length of defect list...
	 lda	f.eaddr+1
	 sbc	#high f.etable
	 sta	f.ndef

	lda	f.ndef+1
	clc
	adc	#4
	sta	f.loft
	 lda	f.ndef
	 adc	#0
	 sta	f.loft+1

	jsr	sort		; sort the defects in the list...
	jsr	setcom
	 dc.b	6		; Format with complete defect list
	 dc.b	$04,$1C,0,0,2,0
	jsr	hard
	 dc.w	f.defects
f.loft	 dc.w	0		; length of defect table
	 dc.b	-1
	bpl	f.fmtok2
	 jmp	erformat

f.fmtok2	dec	f.tpass
	beq	f.exit
	 jmp	f.vtop
f.exit	jsr	print
	 dc.b	$9B,$9B,"Not all defects were found, you"
	 dc.b	$9B,"need to map the sectors out in"
	 dc.b	$9B,"the VTOC after you build the"
	 dc.b	$9B,"directory structure!",$9B,-1
	jmp	f.good


;	Sort the defects listed in the defect list
;	------------------------------------------
sort:	lda	#low f.etable
	ldx	#high f.etable

f.sortop	sta	tp
	stx	tp+1

f.sear	clc
	adc	#8
	bcc	f.ncx1
	 inx
f.ncx1	cmp	f.eaddr
	bne	f.noten
	 cpx	f.eaddr+1	; if search ptr hit end, then advance
	 beq	f.next1		;  tp

f.noten	sta	ntp
	stx	ntp+1
	jsr	compare		; looking for an ntp<tp
	lda	ntp
	ldx	ntp+1		; advance to next if ntp>=tp
	bcs	f.sear		; (compare is ntp-tp)

	ldy	#7
f.excha	lda	(tp),y
	pha
	 lda	(ntp),y		; exchange items in list...
	 sta	(tp),y
	pla
	sta	(ntp),y
	dey
	bpl	f.excha
	 lda	ntp
	 ldx	ntp+1
	 jmp	f.sear		; continue

f.next1	clc
	lda	tp		; tp is now lowest, advance tp
	ldx	tp+1
	adc	#8
	bcc	f.ncx2
	 inx
f.ncx2	cmp	f.eaddr
	bne	f.sortop
	 cpx	f.eaddr+1
	 bne	f.sortop
	rts			; if tp=end, then all done

compare	ldy	#7
	sec
f.comp2	lda	(ntp),y
	sbc	(tp),y
	dey
	bpl	f.comp2
	rts


f.fixed	ds.b	1
f.blocks	ds.b	3
f.times	ds.b	1
f.tpass	ds.b	1
f.terror	ds.b	1

				; Mode Select data block for Adaptec
f.modsel	dc.b	0,0,0,8		; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	dc.b	0,0,0,0,0,0,1,0
f.fortc	dc.b	1
f.acyln	dc.w	0
f.ahead	dc.b	0
	dc.b	615 /256	;high 615
	dc.b	615 & $ff	;low 615	; write curr
	dc.b	615 /256	;
	dc.b 	615 & $ff	;; write precomp
	dc.b	0
f.stepra	dc.b	2
	dc.b	$00,32

				; Defect list for adaptec 4000
f.defects	dc.w	0		; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
f.ndef	dc.w	0		; # of defects (filled in)
f.etable	ds.b	8*128

				; Search data record for adaptec
				; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
f.sdata	dc.b	0,0,1,0		; rec size = 256
	dc.b	0,0,0,0		; offset = 0
	dc.b	0,0,0,0		; # records (filled in)
	dc.b	1,6		; pattern length = 256+6
	dc.b	0,0,0,0		; disp in record = 0
	dc.b	1,0		; pattern length = 256
	ds.b	256		; pattern data
;


;
;==================================================
;	Format and verify Iomega Series
;==================================================

;	Format an Iomega Hard Disk
;	--------------------------
iomega
	jsr	setcom
	 dc.b	6
	 dc.b	4,0,0,0,0,0	; format disk command
	jsr	hard
	 dc.w	0,0
	 dc.b	0
	bpl	f.iokhd1
	 jmp	erformat

f.iokhd1	jsr	delay5
	jsr	delay5

f.iokhd2	jsr	delay5
	jsr	setcom
	 dc.b	3,0,0,0,4,0	; request sense command
	jsr	hard
	 dc.w	senseb
	 dc.w	4		; get 4 byte sense data
	  dc.b	0
	 bpl	f.ioksen1

	 and	#8
	 beq	f.baer11	; jump if unit not busy..
	JSR	PRINT
	 dc.b	".",-1
	jmp	f.iokhd2

f.baer11	 txa
	 jsr	print
	  dc.b	$9B,$9B,"Sense Request Failed!",$9B,$9B,-1
	 jsr	error
	 jmp	abort

f.ioksen1	jsr	readcap		; read drive capacity
	jmp	xformat

delay5	lda	$14
f.del5b	cmp	$14
	beq	f.del5b
	ldx	$13
	inx
	inx
	inx
	inx
f.del6	cpx	$13
	bne	f.del6
	 cmp	$14
	 bne	f.del6
	rts
;


;
;============================================
;	Format XEBEC 1410/1410A
;============================================

;	Format XEBEC type drive
;	-----------------------
xebec
	 lda	#0
	 sta	curbad
	lda	#1
	jsr	setcfg		; set configuartion for format...

	lda	#0
	sta	f.block
	sta	f.block+1
	sta	f.block+2

f.confmt	jsr	setcom
	 dc.b	6
	 dc.b	4
f.block	 dc.b	0,0,0,1,7	; format command

	jsr	hard		; format...
	 dc.w	0,0
	 dc.b	0
	bmi	f.ffail
	and	#2
	bne	f.iser11
	 jmp	f.pass1ok

f.iser11	lda	senseb
	bmi	f.senok1
f.ffail	 jsr	print
	 dc.b	$9B,$9B,"Format Failed!",$9B,$9B,-1
	 jsr	error
	 jmp	abort

f.senok1	ldx	curbad
	lda	senseb+3
	sta	badt1,x
	clc
	adc	#32
	sta	f.block+2
	 lda	senseb+2
	 sta	badt2,x
	 adc	#0
	 sta	f.block+1
	  lda	senseb+1
	  sta	badt3,x
	  adc	#0
	  sta	f.block
	  sta	command+1
	 inc	curbad
	 lda	curbad
	 cmp	#20
	 bcs	f.ffail
	jmp	f.confmt

f.pass1ok	lda	#0		; Finished first format pass... fill
	sta	tbad		;  in bad tracks...
	cmp	curbad
	beq	f.pass2ok	; if at end of bad tracks, then skip...
	 jsr	print
	  dc.b	$9B,$9B,-1

f.totop1	jsr	onesub
	jsr	setcom
	 dc.b	6
	 dc.b	7
f.btrack	 dc.b	0,0,0,1,7	; set format bad track

	jsr	hard		; format bad track...
	 dc.w	0,0
	 dc.b	0
	bpl	f.netrz
f.fail3	 jsr	print
	  dc.b	$9B,$9B,"Format BAD Track Failed!",$9B,$9B,-1
	 jsr	error
	 jmp	abort

f.netrz	and	#2
	bne	f.fail3
	inc	tbad
	lda	tbad
	cmp	curbad
	bne	f.totop1

f.pass2ok	lda	heads		; need cyln * heads * 32
	sta	mula
	lda	cyln
	sta	mulb
	 lda	cyln+1
	 sta	mulb+1
	jsr	multiply	; res = mula * mulb
	ldx	#5		; now multiply by 32 for total sectors
f.tlop4	asl	res
	rol	res+1
	rol	res+2
	 dex
	 bne	f.tlop4		; now RES = total number free sectors...

	jsr	vxebec		; now verify entire disk... reassign
				;  blocks as needed...
	lda	#11
	jsr	setcfg		; reconfigure drive...
	jmp	xformat

onesub	ldx	tbad
	lda	badt3,x
	sta	bycou+2
	sta	f.btrack
	 lda	badt2,x
	 sta	bycou+1
	 sta	f.btrack+1
	  lda	badt1,x
	  sta	bycou
	  sta	f.btrack+2
	jsr	print
	 dc.b	"Formatting Bad Track: at #",-1
	jsr	prbycou
	jsr	print
	 dc.b	$9B,-1
	rts
;


;	Set drive configuration
;	-----------------------
setcfg
	sta	f.cfgbuf+7	; set ECC to 1 or 11
	 lda	cyln
	 sta	f.cfgbuf+1
	lda	cyln+1
	sta	f.cfgbuf+0
	 lda	heads
	 sta	f.cfgbuf+2

	jsr	setcom
	 dc.b	6
	 dc.b	$0C,0,0,0,0,0
	lda	#0
	sta	command+1	; No LUNIT in command frame...
	jsr	hard
	 dc.w	f.cfgbuf
	 dc.w	8
	 dc.b	-1
	bpl	f.ok
	 jsr	print
	 dc.b	$9B,$9B,"Could not configure drive!",$9B,$9B,-1
	 jsr	error
	 jmp	abort
f.ok	rts

f.cfgbuf	dc.b	0,0,0
	dc.b	$00,$80,$00,$00,$0B
;


;	Verify XEBEC format
;	-------------------
; in:
;	res	= number logical blocks to verify
vxebec
	lda	#1
	sta	752
	 lda	#1
	 sta	count
	jsr	print
	 dc.b	$9B,$9B,"Verifying Sector # ",-1

	lda	#0
	sta	f.rblock
	sta	f.rblock+1
	sta	f.rblock+2

f.neread	jsr	setcom
	 dc.b	6
	 dc.b	8
f.rblock	 dc.b	0,0,0,1,7	; read command

	lda	f.rblock
	sta	bycou+2
	 lda	f.rblock+1	; set sector number...
	 sta	bycou+1
	  lda	f.rblock+2
	  sta	bycou
	dec	count
	bne	f.nocou
	 lda	#8
	 sta	count
	lda	#7
	sta	fieldln
	jsr	prbycou
	jsr	clend
	jsr	print
	 dc.b	30,30,30,30,30,30,30,-1

f.nocou	jsr	hard
	 dc.w	f.secbuf
	 dc.w	256
	 dc.b	0
	bmi	f.xokver1
	and	#2
	beq	f.okver1
	 jsr	remap
	 jmp	f.com11

f.okver1	inc	f.rblock+2
	bne	f.com11
	 inc	f.rblock+1
	 bne	f.com11
	  inc	f.rblock

f.com11	lda	f.rblock
	cmp	res+2
	bne	f.neread
	 lda	f.rblock+1
	 cmp	res+1
	 bne	f.neread
	  lda	f.rblock+2
	  cmp	res
	  bne	f.neread
	lda	#0
	sta	752
	 jsr	print
	  dc.b	$9B,$9B,-1
	rts			; if at end, then all verified...

f.xokver1	jsr	print
	 dc.b	$9B,$9B,"Format verify failed!",$9B,$9B,-1
	jsr	error
	jmp	abort
f.secbuf	ds.b	256

remap	lda	f.rblock
	sta	bycou+2
	 lda	f.rblock+1	; set sector number...
	 sta	bycou+1
	  lda	f.rblock+2
	  sta	bycou

	jsr	prbycou
	jsr	print
	 dc.b	" is BAD",$9B,-1

				; Reassign track for SASI
				; -----------------------
f.badasg	jsr	showse		; get sense data and display

	lda	f.rblock
	sta	f.newlog
	 lda	f.rblock+1
	 sta	f.newlog+1
	  lda	f.rblock+2
	  and	#$E0
	  sta	f.newlog+2
	jsr	setcom
	 dc.b	6
	 dc.b	$0E
f.newlog	 dc.b	0,0,0,1,7

	 lda	res
	 sec
	 sbc	#32
	 sta	res
	 sta	bycou
	 sta	newtrk+2
	  lda	res+1
	  sbc	#0
	  sta	res+1
	  sta	bycou+1
	  sta	newtrk+1
	 lda	res+2
	 sbc	#0
	 sta	res+2
	 sta	bycou+2
	 sta	newtrk

	 jsr	print
	  dc.b	"  Reassigning track to # ",-1
	jsr	prbycou
	jsr	print
	 dc.b	$9B,-1

	jsr	hard
	 dc.w	newtrk		; send new track number as parameter
	 dc.w	3
	 dc.b	-1
	bmi	f.badasx	; jump if bad reassign track
	and	#2
	bne	f.badasg

	 lda	f.rblock+2
	 and	#$E0		; start at beginning of track again
	 sta	f.rblock+2

	 jsr	print
	 dc.b	"Verifying Sector # ",-1
	 lda	#1
	 sta	count
	rts

f.badasx	jsr	print
	 dc.b	"Command failed!",$9B,-1
	jmp	abort

newtrk	ds.b	3
;

;
;===================================================
;	General high level disk subroutines
;===================================================

;	Request sense
;	-------------
getsense
	jsr	setcom
	 dc.b	3,0,0,0,4,0
	jsr	hard
	 dc.w	senseb
	 dc.w	4
	 dc.b	0		; get sense data
	bpl	f.oksen1
	 jsr	print
	  dc.b	$9B,$9B,"Sense Request Failed!",$9B,$9B,-1
	 jsr	error
	 jmp	abort
f.oksen1	rts
;


;	Read drive capacity
;	-------------------
; out:
;	res	= last+1 logical block on hard disk
readcap
	jsr	setcom
	 dc.b	10
	 dc.b	$25,0,0,0,0
	 dc.b	0,0,0,0,0
	jsr	hard
	 dc.w	captabl
	 dc.w	8
	 dc.b	0		; read capacity
	bpl	f.okcap1
	 jsr	print
	 dc.b	$9B,$9B,"Could not read capacity",$9B,-1
	 jsr	error
	 jmp	abort

f.okcap1	clc
	lda	captabl+3
	adc	#1
	sta	res
	 lda	captabl+2
	 adc	#0
	 sta	res+1
	  lda	captabl+1
	  adc	#0
	  sta	res+2
	rts
;


;
;===========================================
;	Exit from Hard Disk Format
;===========================================

;	Finish up with output to user
;	-----------------------------
; in:
;	res	= total # sectors

xformat
	jsr	print
	 dc.b	$9B,$9B,"Formatted Successfully...",$9B,$9B,-1

	jsr	seram		; set to system RAM to read table
	jsr	sedrive		; search for ID/LUN drive...
	ldy	opt
	lda	multit,y
	 beq	f.nomult
	jmp	f.ismulti	; jump if multiple drives attached

f.nomult	 jsr	print
	  dc.b	"Entire hard disk allocated to D",-1
	 lda	dunit
	 ora	#'0'
	 jsr	prch
	 jsr	print
	  dc.b	":",$9B,$9B,-1

	 lda	res+2
	 beq	f.notrunc
	  jsr	print
	  dc.b	"Drive is larger than 16Meg... Thus a",$9B
	  dc.b	"portion of the drive will be unused.",$9B,$9B,-1

	jsr	seram		; set to system RAM to read table
	ldx	device
	lda	#255
	sta	mio.dridata+5,x
	sta	mio.dridata+4,x
	 lda	#0
	 sta	mio.dridata+3,x
	 jmp	f.cstart

f.notrunc	jsr	seram		; set to system RAM to read table
	ldx	device
	lda	res
	sta	mio.dridata+5,x
	 lda	res+1
	 sta	mio.dridata+4,x
	  lda	res+2
	  sta	mio.dridata+3,x
f.cstart	lda	#1
	sta	mio.dridata+2,x
	 lda	#0
	 sta	mio.dridata+1,x
	 sta	mio.dridata+0,x

	jsr	print
	 dc.b	"Now you should use the Configuration",$9B
	 dc.b	"Menu to save the drive parameters",$9B
	 dc.b	"calculated by this program.",$9B,$9B,-1
	jmp	f.shows

f.ismulti	jsr	print
	 dc.b	"The Hard Drive is to be partitioned",$9B
	 dc.b	"into several drives. You must enter",$9B
	 dc.b	"the Configuration Menu and set values",$9B
	 dc.b	"for Start & End Sector #s.  (Refer to",$9B
	 dc.b	"the section 'Partitioning Hard",$9B
	 dc.b	"Drives' for more help.)  After you",$9B
	 dc.b	"have set these parameters, you should",$9B
	 dc.b	"save the configuration.",$9B,$9B,-1

f.shows	jsr	print
	 dc.b	"For future reference, there are",$9B,-1
	lda	res
	sta	bycou
	 lda	res+1
	 sta	bycou+1
	  lda	res+2
	  sta	bycou+2
	jsr	prbycou		; print byte count
	jsr	print
	 dc.b	" sectors on this Hard Drive.",$9B,$9B,-1
	jmp	abort
;

;	Print out error code
;	--------------------
error
	pha
	jsr	print
	 dc.b	"Error stats are: A=",-1
	jsr	prby
	tya
	jsr	print
	 dc.b	" Y=",-1
	jsr	error_prby
	jsr	print
	 dc.b	$9B,$9B,-1
	pla
	and	#2
	beq	f.skerr1

	 jsr	getsense

showse:	 ldx	#0
	 jsr	print
	  dc.b	"Sense data is: ",-1
f.tlopa	 lda	senseb,x
	 jsr	error_prby
	 jsr	print
	  dc.b	" ",-1
	 inx
	 cpx	#4
	 bne	f.tlopa
	jsr	print
	 dc.b	$9B,-1
f.skerr1	rts
;

error_prby
	pha
	lsr
	lsr
	lsr
	lsr
	jsr	.prnib
	pla
.prnib	and	#15
	clc
	adc	#'0'
	cmp	#':'
	bcc	f.les1
	 adc	#6
f.les1	jmp	prch
;

;	Various error exits
;	-------------------
erconfig
	jsr	print
	 dc.b	$9B,$9B,"Could not Configure Drive.",$9B,-1
	jsr	error
	jmp	abort
;

erformat
	 jsr	print
	 dc.b	$9B,$9B,"Could Not Format Drive.",$9B,-1
	 jsr	error
	 jmp	abort
;

;	Abort from formatter
;	-------------------
abort	ldx	stack
	txs
	jmp	xseram


;
;============================================
;	Misc Math and Print routines
;============================================

;	perform 8 x 16 multiply
;	-----------------------
; in:
;	mula	= 8 bit multiplier
;	mulb	= 16 bit multiplicand
; out:
;	res	= result (24 bit)

mula	dc.b	0
mulb	dc.b	0,0,0
res	dc.b	0,0,0

multiply	ldx	#8
	lda	#0
	sta	res
	sta	res+1
	sta	res+2
	sta	mulb+2
tmul	lsr	mula
	bcc	noadq
	 clc
	 lda	res
	 adc	mulb
	 sta	res
	  lda	res+1
	  adc	mulb+1
	  sta	res+1
	 lda	res+2
	 adc	mulb+2
	 sta	res+2
noadq	asl	mulb
	rol	mulb+1
	rol	mulb+2
	 dex
	 bne	tmul
	rts


yousure	jsr	print
	 dc.b	"Caution: This Destroys All Data!",$9B,$9B
	 dc.b	"------>  Are You Sure ?",-1
again	jsr	inkey
	cmp	#'Y'
	beq	yes
	cmp	#'y'
	beq	yes
	 cmp	#'N'
	 beq	no
	 cmp	#'n'
	 bne	again
no	jsr	print
	 dc.b	"N",$9B,$9B,-1
	jmp	abort

yes	jsr	print
	 dc.b	"Y",$9B,$9B,$9B,"Formatting Unit Number ",-1
	lda	busID
	ora	#'0'
	jsr	prch
	 jsr	print
	  dc.b	",",-1
	lda	Unit
	lsr
	lsr
	lsr
	lsr
	lsr
	ora	#'0'
	jsr	prch
	jsr	print
	 dc.b	" ...",-1
	rts


;
;===================================================
;	Misc routines used by Main entry
;===================================================

;	Search for DUNIT that contains OPT info
;	---------------------------------------
sedrive	lda	#1
	sta	dunit
	ldy	opt
nedri2	jsr	unitX		; get unit index
	lda	mio.dridata+6,x
	bpl	csedri
	 and	#7
	 ldy	opt
	 cmp	optIDt,y
	 bne	csedri
	 lda	mio.dridata+7,x
	 and	#$E0
	 cmp	optLUNt,y
	 beq	fodri		; jump if drive found...
csedri	inc	dunit
	lda	dunit
	cmp	#9
	bne	nedri2
	 lda	#-1		; not found status
fodri	rts


;	Get physical parameters
;	-----------------------
geparam	lda	mio.dridata+7,x
	and	#$10
	sta	sasif		; sasi flag
	 lda	dritype,x
	 sta	cyln+1
	  lda	dritype+1,x
	  sta	cyln
	 lda	dritype+2,x
	 sta	heads
	rts


;	Print drive info
;	----------------
prinfo	lda	sasif
	beq	isnosa
	 jsr	print
	 dc.b	"SASI ",-1
	 jmp	info2
isnosa	jsr	print
	 dc.b	"SCSI ",-1
info2	ldy	opt
	lda	optIDt,y
	ora	#'0'
	jsr	prch

	jsr	print
	 dc.b	"   ",-1
	lda	optLUNt,y
	lsr
	lsr
	lsr
	lsr
	lsr
	ora	#'0'
	jsr	prch
	jsr	print
	 dc.b	"  ",-1

	lda	cyln
	sta	bycou
	 lda	cyln+1
	 sta	bycou+1
	lda	#0
	sta	bycou+2
	 lda	#4
	 sta	fieldln
	jsr	prbycou		; print # cylinders
	jsr	clend
	jsr	print
	 dc.b	"  ",-1
	lda	heads
	ora	#'0'
	jsr	prch
	jsr	print
	 dc.b	"    ",-1
	rts


;	Get Drive index from DUNIT
;	--------------------------
unitX
	ldx	dunit
	dex
	txa
	asl
	asl
	asl
	tax
	stx	device
	rts
;

device	ds.b	1
cyln	ds.b	2
heads	ds.b	1
opt	ds.b	1
curopt	ds.b	1
sasif	ds.b	1
optLUNt	ds.b	8
optIDt	ds.b	8
multit	ds.b	8
stack	ds.b	1
captabl	ds.b	8
count	ds.b	1
tbad	ds.b	1
curbad	ds.b	1
badt3	ds.b	20
badt2	ds.b	20
badt1	ds.b	20


;	Print byte count
;	----------------
prbycou:
	ldx	#7		; setup for 8 digit output
f.ndig	stx	f.place
	ldx	#24		; 24 bit division
	lda	#0
f.repdt	asl	bycou
	rol	bycou+1
	rol	bycou+2
	rol
	 lsr	bycou
	cmp	#10
	bcc	f.nx2x
	 sbc	#10
f.nx2x	rol	bycou
	dex
	bne	f.repdt
	 ora	#'0'		; convert remainder to digit
	ldx	f.place
	sta	f.decout,x
	 dex
	 bmi	f.coutd
	  lda	bycou
	  ora	bycou+1		; if not zero, then have more digits
	  ora	bycou+2
	  bne	f.ndig

f.coutd	inx
	lda	f.decout,x
	jsr	prch		; print char ASCII buffer
	cpx	#7
	bne	f.coutd
f.xcle	rts

f.place	ds.b	1
f.decout ds.b	8
bycou	ds.b	3


;	Print character
;	---------------
; in:
;	A	= character to print
; out:
;	all registers preserved

prch
	jsr	saver
	jsr	zout
	jmp	resall

zout	sta	ztemp
	lda	$347
	pha
	 lda	$346
	 pha
	ldx	#0
	lda	ztemp
	rts



;	Print text
;	----------
; out:
;	all registers preserved
; notes:
;	This print routine will print all characters
;	following the JSR PRINT until a delimiter of
;	-1 ($FF) is reached. PRINT will return to the
;	point one byte beyond the delimiter.

print
	jsr	saver
	tsx
	lda	$105,x
	sta	.zoch+1
	 lda	$106,x
	 sta	.zoch+2

	ldy	#1
.zoch	lda	$ffff,y
	cmp	#$ff
	beq	.zecho
	 jsr	prch
	 iny
	 bne	.zoch
.zecho	tya
	clc
	adc	$105,x
	sta	$105,x
	 lda	$106,x
	 adc	#0
	 sta	$106,x
	jmp	resall



;	Print byte
;	----------
; in:
;	A	= byte to print
; out:
;	all registers preserved

prby	jsr	saver
	jsr	zoutbyt
	jmp	resall

zoutbyt	pha
	lsr
	lsr
	lsr
	lsr
	jsr	.zob
	 pla
.zob	and	#$0f
	ora	#$30
	cmp	#$3a
	bcc	.zkkkk
	 adc	#6
.zkkkk	jsr	prch
	rts



;	Print word
;	----------
; in:
;	XA	= word to print
; out:
;	all registers preserved

prwo	jsr	saver
	pha
	txa
	jsr	zoutbyt
	pla
	jsr	zoutbyt
	jmp	resall



;	SAVE & RESTORE registers
;	------------------------

saver	php
	pha
	pha
	pha
	php
	pha
	txa
	pha
	tsx
	lda	$109,x
	sta	$105,x
	lda	$107,x
	sta	$109,x
	lda	$101,x
	sta	$107,x
	lda	$108,x
	sta	$104,x
	lda	$106,x
	sta	$108,x
	tya
	sta	$106,x
	pla
	tax
	pla
	plp
	rts

resall	pla
	tay
	pla
	tax
	pla
	plp
	rts

;	Clear to end of field
;	---------------------
clend:
	lda	.fieldln
	bmi	..xcle
	beq	..xcle
	 lda	#' '
	 jsr	prch
	 jmp	clend
..xcle	rts

.fieldln: dc.b	0	; this may need to be removed



;	Get character from keyboard
;	---------------------------
inkey	jsr	inke2
xlda	lda	#0
	rts

inke2	jsr	saver
	jsr	gekey
	 sta	xlda+1
	jsr	seram
	jmp	resall

gekey	lda	$E425
	pha
	 lda	$E424
	 pha
	 rts

ztemp	ds.b	1


;======================================
;	Main Hard Drive Calls
;======================================

;	Set command frame for hard drive I/O
;	------------------------------------
setcom:
	pla
	sta	zp
	 pla
	 sta	zp+1
	ldy	#1
	lda	(zp),y
	sta	comlen
	tax
f.setop	 iny
	 lda	(zp),y
	 sta	command-2,y
	dex
	bne	f.setop
	tya
	clc
	adc	zp
	tax
	 lda	#0
	 adc	zp+1
	 pha
	txa
	pha
	 lda	command+1
	 ora	unit		; LUN
	 sta	command+1
	rts

command: ds.b	10
comlen	ds.b	2	; length of command
;


;	Hard drive command execute
;	--------------------------
hard:	
	pla
	sta	zp
	 pla
	 sta	zp+1
	ldy	#1
	lda	(zp),y
	sta	dptr
	 iny
	 lda	(zp),y
	 sta	dptr+1
	iny
	lda	(zp),y
	sta	blockln
	 iny
	 lda	(zp),y
	 sta	blockln+1
	iny
	lda	(zp),y
	sta	hdirect
	 tya
	clc
	adc	zp
	tax
	 lda	#0
	 adc	zp+1
	 pha
	txa
	pha
	jsr	xhdio
	bmi	f.bad
	 pha
	 and	#2
	 beq	f.nosts		; jump if no extended sense...
	jsr	setcom
	 dc.b	6
	 dc.b	3,0,0,0,4,0
	jsr	hard
	 dc.w	senseb
	 dc.w	4
	 dc.b	0
f.nosts	pla			; A = status from main operation
	cpy	#0
f.bad	rts

blockln	ds.b	2
senseb:	ds.b	4
hdirect	ds.b	1		; direction...
;


;
;===============================================
;	Hard Drive support functions
;===============================================

busid:	ds.b	1	; SCSI controller ID     (unitID)
unit:	ds.b	1	;  unit number on controller (LUN)

;	Perform general Hard Disk I/O
;	-----------------------------
xhdio	
	SEI
	jsr	hdready		; check if HD is ready
	 bcs	f.balog		; exit if error...
	LDA	INPUTS
	AND	#HDIO		; IF INPUT TO US, THEN MUST BE IOMEGA
	BEQ	f.comer		;  DRIVE (HARDWARE BUSY)..

	jsr	sencom		; send command frame
f.wareq	bit	inputs		; wait for REQ-
	bmi	f.wareq
	 lda	inputs		; now must start data phase... if not,
	 and	#hdcd		;  then must have status... go get
	 beq	f.comer		;  status
	jsr	rwdata		; perform data phase... read/write buffer
f.wareb	bit	inputs
	bmi	f.wareb		; wait for request (status type request)
	 lda	inputs
	 and	#hdcd		; must be command (actually status read)
	 bne	f.daer		; jump if still thinking data
f.comer	jsr	hdstat
	 clc
	 CLI
	 ldy	#1
	 rts
f.balog	ldy	#$8A		; give timeout if not REQ given
	 dc.b $2C
f.daer	ldy	#$E0		; give interface error
	CLI
	cpy	#0
	sec
	rts
;


;	Read/Write sector buffer
;	------------------------
rwdata	
	lda	inputs
	eor	hdirect
	and	#hdio
	bne	rwdata		; wait until I/O is correct
	 inc	blockln+1
	bit	hdirect
	bpl	f.rtop		; jump if reading data

f.wtop	dec	blockln+1
	bmi	f.fini		; jump if finished...
	bne	f.fullw		; jump if a full page left
	 ldx	blockln
	 beq	f.fini
	 dc.b $2C
f.fullw	ldx	#0
	ldy	#0
f.wdata	bit	inputs		; wait for request..
	bmi	f.wdata
	lda	(dptr),y
	eor	#-1
	sta	daout		; send data to HD
	 iny
	 dex
	 bne	f.wdata
	inc	dptr+1
	jmp	f.wtop

f.rtop	dec	blockln+1
	bmi	f.fini		; jump if finished...
	bne	f.fullr		; jump if a full page left
	 ldx	blockln
	 beq	f.fini
	 dc.b $2C
f.fullr	ldx	#0
	ldy	#0
f.rdata	bit	inputs		; wait for request...
	bmi	f.rdata
	lda	dain		; read data from HD
	eor	#-1
	sta	(dptr),y
	 iny
	 dex
	 bne	f.rdata
	inc	dptr+1
	jmp	f.rtop
f.fini	rts
;


;	Send command frame to SCSI device
;	---------------------------------
sencom	
	ldy	comlen
	ldx	#0
f.neou	lda	command,x
	eor	#-1
	sta	daout		; set output data...
..wareq	 bit	inputs
	 bmi	..wareq
	inx
	dey
	bne	f.neou
	rts
;


;	Read hard drive status
;	----------------------
hdstat	
	lda	dain
	ldx	#0
f.replp	bit	inputs
	bpl	f.ldain
	 dex
	 bne	f.replp
	BEQ	f.LDAIN3
f.ldain	ldy	dain		; remove second status byte just incase
f.LDAIN3	eor	#-1
	and	#$1F		; strip LUN bit... FIX 9/3/86
	rts
;


;	Perform selection of hard disk
;	------------------------------
hdready	
	lda	inputs
	and	#hdbusy		; if not busy, then go on to selection
	beq	f.hderr		;  else jump to error

	ldx	busID
	lda	f.scsix,x	; set unit ID...
	eor	#-1
	sta	daout		; put on data bus...
f.waiou	 lda	inputs
	 and	#hdio		; wait until assured that we're output
	 beq	f.waiou
	lda	#ramen+selstro	; strobe SELECT low until not BUSY...
	sta	miscout
	ldx	#100		; Must assert BUSY within 200us
f.buslp	lda	inputs
	and	#hdbusy		; wait until HD goes busy...
	beq	f.conreq	; if BUSY, then continue with first REQ
	 dex			;  check... else keep looping
	 bne	f.buslp
f.hderr	lda	#ramen
	sta	miscout
	sec			; return with error...
	rts

f.conreq	lda	#ramen		; restore MISCOUT
	sta	miscout
	jsr	waireq		; wait for request
	bcs	f.hderr		;  if never happened... then error
	 lda	inputs
	 and	#hdcd		; Must be asking for command...
	 bne	f.hderr
	clc
	rts

f.scsix	dc.b $01,$02,$04,$08,$10,$20,$40,$80
;


;	Wait for request with timeout
;	-----------------------------
waireq	
	ldx	#0
f.waire	bit	inputs		; jump if is request
	bpl	f.isreqw
	 dey
	 bne	f.waire		; continue checking...
	 dex
	 bne	f.waire
	sec
	rts
f.isreqw	clc
	rts
;


;	Set to system RAM
;	-----------------
seram:	SEI
	ldx	#0
	stx	mio.RAMPAGE
	 lda	#ramen		; set to system RAM...
	 sta	miscout
	 sta	Smisc		; shadow MISCOUT
	 stx	curpage
	CLI
	rts

;	Exit from system ram
;	--------------------
xseram:	SEI
	lda	prirq
	sta	Smisc		; set shadow from PRIRQ
	sta	miscout
	CLI
	rts

win_end:	ds.b	0


;rest of the code 
