A2osX/ProDOS.FX/ProDOS.S.XRW.txt

NEW
  AUTO 3,1
*--------------------------------------
* If Called by ProDOS : SEI
* If Called directly from GP.DEVPTRS vectors : ????
*--------------------------------------
XRW.START		.PH	XRW

XRW.START1		cld						$D8 to flag language card bank 1 (main)

				lda ZP.UNITNUM			get unit number.

				pha

				lsr
				lsr
				lsr
				lsr
				sta XRW.UnitIndex
				tax
				lda XRW.D2SeekTime-1,x
				bne .10

				lda #IO.D2.SeekTimeP

.10				sta XRW.SeekTime

				stz XRW.montimel

				pla

				and #$7F	  			mask off high bit.
				sta ZP.A2L				0SSS0000 for IO indexing

* make sure other drives in other slots are stopped

				eor XRW.LastUnitUsed	same slot as last ?
				asl
				beq XRW.Blk2TS

				lda #$01
				sta XRW.montimeh

.1  			lda XRW.LastUnitUsed
				and #$70
				tax
				beq XRW.Blk2TS			branch if no previous ever (boot only).

				jsr XRW.CheckMotorOnX	check if previous drive running.
				beq XRW.Blk2TS			branch if stopped.

				jsr XRW.Wait100usec

				lda XRW.montimeh
				bne .1
*--------------------------------------
XRW.Blk2TS		lda ZP.BLKNUM
				sta XRW.ReqTrack

				and #7
				cmp #4
				php
				and #3
				asl
				plp
				rol
				sta XRW.ReqSector

				lda ZP.BLKNUM+1

				ldx #3

.1				lsr
				ror XRW.ReqTrack
				dex
				bne .1
*--------------------------------------
				ldx ZP.A2L
				jsr XRW.ReadMode

				jsr XRW.CheckMotorOn

				php						SAVE IRQ STATE

				php						save motor on state : NZ if on

				lda #$E8				24 up to 0
				sta XRW.montimeh

				lda ZP.UNITNUM			determine drive 1 or 2.
				cmp XRW.LastUnitUsed	same slot/drive used before ?
				sta XRW.LastUnitUsed	save it for next time.
				php		  				keep results of compare.

				asl 					get drive # into carry.
				bcc .3					branch if drive 1 selected.

				inx		  				select drive 2.

.3				lda IO.D2.DrvSel1,x

				ldx ZP.A2L
				lda IO.D2.DrvOn,x  		turn on the drive.

				plp		  				was it the same drive ?
				beq .5					yes.

				plp		  				NZ: indicate drive off by setting z-flag.

				ldy #6

.4				jsr XRW.Wait25600usec	150 ms delay before stepping.
				dey
				bne .4

				php						Z set

.5  			plp						was motor on ?
				bne XRW.Cmd				if so, don't wait.

* motor was off, wait for it to speed up

.6  			jsr XRW.Wait100usec		wait 100us for each count in montime

				lda XRW.montimeh
				bmi .6					count up to 0000

* motor should be up to speed,
* if it looks stopped then the drive is not present

				jsr XRW.CheckMotorOn	is drive present ?
				beq XRW.E.ND
*--------------------------------------
XRW.Cmd			lda ZP.CMDNUM			get command #
				bne .1

				jsr XRW.TestWP			0 = status
				bcs XRW.E.WP

				bcc XRW.E.OK

.1				cmp #4		   			3 = format
				bcs XRW.E.IO

				cmp #2					2 = Write, 1 = Read

				ror XRW.bWrite			b7 = 1 if Write
				bpl .2

				jsr XRW.TestWP
				bcs XRW.E.WP
*--------------------------------------
.2				sei						DISABLE IRQ

				lda #2
				sta XRW.RecalibrateCnt

.3				jsr XRW.TrackSelect
				bcs XRW.E.IO

				jsr XRW.SectorIO
				bcc .4

				jsr XRW.Recalibrate
				bcc .3

				bcs XRW.E.IO

.4				inc ZP.BUFPTR+1

				inc XRW.ReqSector
				inc XRW.ReqSector

				jsr XRW.SectorIO		get 2nd half of block
				dec ZP.BUFPTR+1

				bcc XRW.E.OK

XRW.E.IO		lda #MLI.E.IO
				.HS 2C					BIT ABS
XRW.E.WP		lda #MLI.E.WRTPROT
				.HS 2C					BIT ABS
XRW.E.ND		lda #MLI.E.NODEV

				plp						RESTORE IRQ STATE
				sec
				bra XRW.E.EXIT

XRW.E.OK		plp						RESTORE IRQ STATE
				clc
				lda #0

XRW.E.EXIT		ldx ZP.A2L
				bit IO.D2.DrvOff,x
				rts
*--------------------------------------
XRW.SectorIO	bit XRW.bWrite
				bpl .1

				jsr XRW.PreNibble

.1				stz XRW.RetryCnt

.2				jsr XRW.ReadAddr		(..14)
				bcs .3					(2)

				lda XRW.AddrField.S		(4)
				cmp XRW.ReqSector		(4)
				bne .3					(2)

				bit XRW.bWrite			(4)
				bpl XRW.Read			(2)

				jmp XRW.Write			(3)

.3				inc XRW.RetryCnt
				bpl .2

				sec

.9				rts
*--------------------------------------
* read subroutine (16-sector format)
*
* reads encoded bytes into nbuf1 and nbuf2.
* first reads nbuf2 high to low, then nbuf1 low to high.
* on entry: x=slot# times $10, read mode
* on exit: carry set if error, else if no error:
*	acc=$AA, x=unchanged, y=0, carry clear.
* observe 'no page cross' on some branches !!
*--------------------------------------
				.LIST ON
XRW.Read		txa						get slot #
				.LIST OFF
				ora #$8C	   			prepare mods to read routine.
				sta rd4+1				warning: the read routine is
				sta rd5+1				self modified !!
				sta rd6+1
				sta rd7+1
				sta rd8+1

				lda ZP.BUFPTR			modify storage addresses also
				ldy ZP.BUFPTR+1
				sta ref3+1
				sty ref3+2
				sec
				sbc #$54
				bcs L571F				branch if no borrow

				dey

L571F  			sta ref2+1
				sty ref2+2
				sec
				sbc #$57
				bcs L572B				branch if no borrow

				dey

L572B  			sta ref1+1
				sty ref1+2

				ldy #$20				32 tries to find

L5733  			dey
				beq L576D				branch if can't find data header marks

L5736  			lda IO.D2.RData,x
				bpl L5736

L573B  			eor #$D5	   			1st data mark
				bne L5733

				nop		  				delay

L5740  			lda IO.D2.RData,x
				bpl L5740

				cmp #$AA	   			2nd data mark.
				bne L573B				if not, check for 1st again

				nop

L574A  			lda IO.D2.RData,x
				bpl L574A

				cmp #$AD	   			3rd data mark
				bne L573B				if not, check for data mark 1 again

				ldy #$AA
				lda #$00

L5757  			sta ZP.PCL				use z-page for keeping checksum

rd4				ldx IO.D2.RData+$60	  	warning: self modified
				bpl rd4

				lda XRW.Nib2FC-$96,x
				sta nbuf2-$AA,y	  		save the two-bit groups in nbuf.
				eor ZP.PCL				update checksum.
				iny		  				next position in nbuf.
				bne L5757				loop for all $56 two-bit groups.

				ldy #$AA	  			now read directly into user buffer.
				bne rd5					always taken.

L576D			sec		  				error
				rts

ref1			sta $1000,y				warning: self modified

rd5				ldx IO.D2.RData+$60		warning: self modified
				bpl rd5

				eor XRW.Nib2FC-$96,x	get actual 6-bit data from dnib table.
				ldx nbuf2-$AA,y	  		get associated two-bit pattern
				eor dnibl2,x	   		and combine to form whole byte.
				iny
				bne ref1				loop for $56 bytes.

				pha		  				save for now, no time to store...
				and #$FC	   			strip low bits.
				ldy #$AA	   			prepare for next $56 bytes

rd6				ldx IO.D2.RData+$60	  	warning: self modified
				bpl rd6

				eor XRW.Nib2FC-$96,x
				ldx nbuf2-$AA,y
				eor dnibl3,x
ref2			sta $1000,y				warning: self modified
				iny
				bne rd6					loop unil this group of $56 read

rd7				ldx IO.D2.RData+$60	  	warning: self modified
				bpl rd7

				and #$FC
				ldy #$AC				last group is $54 long

L57A5  			eor XRW.Nib2FC-$96,x
				ldx nbuf2-$AC,y
				eor dnibl4,x	   		combine to form full byte
ref3			sta $1000,y				warning: self modified

rd8				ldx IO.D2.RData+$60		warning: self modified
				bpl rd8

				iny
				bne L57A5

				and #$FC
				eor XRW.Nib2FC-$96,x	checksum ok ?
				bne L57CC				error if not.

				ldx ZP.A2L				test end marks.

L57C2  			lda IO.D2.RData,x
				bpl L57C2

				cmp #$DE

				clc
				beq L57CD				branch if good trailer

L57CC  			sec

L57CD  			pla		 				place last byte into user buffer
				ldy #$55
				sta (ZP.BUFPTR),y
				.LIST ON
XRW.Read.RTS	rts
				.LIST OFF
*--------------------------------------
XRW.TestWP		ldx ZP.A2L
				lda IO.D2.ReadProt,x	test for write protected
				lda IO.D2.ReadMode,x
				rol		 				write protect-->carry-->bit 0=1
				lda IO.D2.RData,x		keep in read mode
				rts
*--------------------------------------
* write subroutine (16 sector format)
*
* writes data from nbuf1 and buf. first nbuf2, high to low then direct
* from (buf), low to high. assumes 1 usec cycle time. self modified code !!
*
* on entry: x = slotnum times 16 (35us since read $DE)
*--------------------------------------
				.LIST ON
XRW.Write		lda IO.D2.ReadProt,x	(4) PREWRITE MODE
				.LIST OFF
				lda IO.D2.ReadMode,x	(4)

				jsr XRW.Write.RTS		(12)

				nop	  					(2)

				lda #$FF   				(2)

				sta IO.D2.WriteMode,x	(5) goto write mode
				ora IO.D2.WShift,x		(4)

				ldy nbuf2				(4)
				sty ZP.PCL				(3)

				ldy #6   				(2)
				nop	  					(2)

.1  			pha	  					(3) exact timing.
				pla	  					(4) exact timing.
				jsr wnibl7   			(18..10) write sync.
				dey	  					(2)
				bne .1					(3) must not cross page !

				nop	  					(2)
				nop	  					(2)

				lda #$D5   				(2) 1st data mark
				jsr wnibl9   			(20..10)

				lda #$AA   				(2) 2nd data mark
				jsr wnibl9  			(20..10)

				lda #$AD   				(2) 3rd data mark
				jsr wnibl9   			(20..10)
				tya	  					(2) zero checksum

				ldy #$56   				(2) nbuf2 index
				bne L583D				(3) branch always

* total time in this write byte loop must = 32us !!!

L583A  			lda nbuf2,y  			(4) prior 6-bit nibl

*L583D 			eor nbuf2-1,y  			(5) xor with current (4+1 : PAGE CROSS)
L583D  			eor nbuf2-1,y  			(4) xor with current (NO MORE PAGE CROSS)

				tax	  					(2) index to 7-bit nibl
				lda XRW.FC2Nib,x   		(4) must not cross page boundary

*				ldx ZP.A2L				(3) restore slot index
				ldx >ZP.A2L				(4) absolute reference to zero page

				sta IO.D2.WLoad,x		(5) store encoded byte
				lda IO.D2.WShift,x		(4) handshake
				dey	  					(2)
				bne L583A				(3-) must not cross page boundary

* end of write byte loop

				lda ZP.PCL				(3) get prior nibl (from nbuf2)

wrefd1			ldy #$00   				(2) warning: load value modified by prenib.

wrefa1			eor $1000,y 			(4) warning: address modified by prenib.
				and #$FC   				(2) strip low 2 bits
				tax	  					(2) index to nibl table
				lda XRW.FC2Nib,x		(4)
wrefd2			ldx #$60   				(2) warning: value modified by prenib.
				sta IO.D2.WLoad,x		(5) write nibl
				lda IO.D2.WShift,x		(4) handshake
wrefa2			lda $1000,y  			(4) prior nibl. warning: address modified by prenib.
				iny	  					(2) all done with this page ?
				bne wrefa1				(3-) loop until page end.

				lda ZP.PCH				(3) get next (precalculated & translated) nibl.
				beq L58C0				(2+) branch if code written was page aligned.

				lda ZP.A2H				(3) get byte address of last byte to be written.
				beq L58B3				(2+) branch if only 1 byte left to write.

				lsr						(2) test for odd or even last byte (carry set/clear)
				lda ZP.PCH				(3) restore nibl to acc.
				sta IO.D2.WLoad,x		(5)
				lda IO.D2.WShift,x		(4)
				lda ZP.A1L				(3) = byte 0 of 2nd page xor'd with byte 1 if
				nop	  					(2) above test set carry.
				iny	  					(2) y=1
				bcs L5899				(2+) branch if last byte to be odd.

wrefa3			eor $1100,y  			(4) warning: address modified by prenib.
				and #$FC   				(2) strip low 2 bits.
				tax		 				(2) index to nibl table
				lda XRW.FC2Nib,x 		(4) get nibl
wrefd3			ldx #$60   				(2) restore slot index. warning: modified by prenib
				sta IO.D2.WLoad,x		(5)
				lda IO.D2.WShift,x		(4)
wrefa4			lda $1100,y  			(4) warning: modified by prenib
				iny	  					(2) got prior nibl, point to next
wrefa5			eor $1100,y  			(4) warning: modified by prenib

L5899  			cpy ZP.A2H				(3) set carry if this is the last nibl
				and #$FC   				(2) strip low 2 bits
				tax	  					(2)
				lda XRW.FC2Nib,x   		(4)
wrefd4			ldx #$60   				(2) restore slot. warning: modified by prenib
				sta IO.D2.WLoad,x		(5)
				lda IO.D2.WShift,x		(4)
wrefa6			lda $1100,y 			(4) get prior nibl. warning: modified by prenib
				iny	  					(2)
				bcc wrefa3				(3-) branch if not the last.
				bcs L58B1				(3) waste 3 cycles, branch always.

L58B1  			bcs L58C0				(3) branch always.

L58B3  			lda	>ZP.PCH 			(4) absolute reference to zero page
				sta IO.D2.WLoad,x		(5)
				lda IO.D2.WShift,x		(4)
				pha	  					(3) waste 14 micro-seconds total
				pla	  					(4)
				pha	  					(3)
				pla	  					(4)

L58C0  			ldx ZP.A1H				(3) use last nibl (anded with $FC) for checksum
				lda XRW.FC2Nib,x 		(4)
wrefd5			ldx #$60   				(2) restore slot. warning: modified by prenib
				sta IO.D2.WLoad,x		(5)
				lda IO.D2.WShift,x		(4)

				ldy #2   				(2) set y = index end mark table.
				pha	  					(3) waste another 11 micro-seconds
				pla	  					(4)
				nop	 					(2)

.1				clc	  					(2)

				lda XRW.EndMark,y	 	(4) DE AA EB
				jsr wnibl				(11..10) write it
				dey	  					(2)
				bpl .1					(3) if not.

				bmi .2					(3)

.2				nop						(2)

				tya						(2)		Y = $FF from DEY BMI
				jsr wnibl				(11..10) write turn off byte.

XRW.ReadMode	lda IO.D2.ReadMode,x	(4) out of write mode
				lda IO.D2.WShift,x		(4) to read mode.

				rts	  					return from write.

* 7-bit nibl write subroutines

wnibl9			clc						(2) 9 cycles, then write.

wnibl7			pha	  					(3) 7 cycles, then write.
				pla	  					(4)

wnibl			sta IO.D2.WLoad,x		(5) nibl write
				ora IO.D2.WShift,x		(4) clobbers acc, not carry
				.LIST ON
XRW.Write.RTS	rts	  					(6)
				.LIST OFF
*--------------------------------------
XRW.Wait25600usec
				lda #0
				.HS 2C					BIT ABS

XRW.Wait100usec	lda #1

XRW.Wait100usecA
				phx

.1				ldx #17					(2)

.2  			dex						(2)
				bne .2					(3)

				inc XRW.montimel		(6)
				bne .3					(3)

				inc XRW.montimeh		(6)

.3				dec						(2)
				bne .1					(3)

				plx
				rts
*--------------------------------------
XRW.CheckMotorOn
				ldx ZP.A2L
XRW.CheckMotorOnX
				ldy #0					init loop counter.

.1  			lda IO.D2.RData,x		read the shift register.
				jsr .9					delay

				pha
				pla		  				more delay.

				cmp IO.D2.RData,x		has shift reg changed ?
				bne .9					yes, motor is moving.

				dey		  				no, dec retry counter
				bne .1					and try 256 times.

.9				rts						Z if motor OFF
*--------------------------------------
				.LIST ON
XRW.ReadAddr	ldy #$FC
				.LIST OFF
				sty XRW.CheckSum		init nibble counter to $FCFC

				ldx ZP.A2L				get slot #

.1  			iny
				bne .2					counter LO

				inc XRW.CheckSum		counter HI
				beq .99

.2  			lda IO.D2.RData,x		read nibl
				bpl .2

.3 				cmp #$D5	 			address mark 1 ?
				bne .1

				nop

.4	 			lda IO.D2.RData,x
				bpl .4

				cmp #$AA	   			address mark 2 ?
				bne .3					if not, is it address mark 1 ?

				ldy #3		   			index for 4 byte read

.5  			lda IO.D2.RData,x
				bpl .5

				cmp #$96	   			address mark 3 ?
				bne .3					if not, is it address mark 1

				lda #0					init Chksum

.6	  			sta XRW.CheckSum

.7  			lda IO.D2.RData,x		read 'odd bit' nibl
				bpl .7

				rol		 				align odd bits, '1' into lsb.
				sta XRW.Temp4x4			save them.

.8  			lda IO.D2.RData,x		read 'even bit' nibl
				bpl .8

				and XRW.Temp4x4			merge odd and even bits.
				sta XRW.AddrField.C,y	store data byte.
				eor XRW.CheckSum
				dey
				bpl .6					loop on 4 data bytes.

				tay		  				if final checksum non-zero,
				bne .99					(2) then error.

.9				lda IO.D2.RData,x		(4)
				bpl .9					(2)

				eor #$DE				(2)
				bne .99					(2)

				clc						(2)
				rts						(6)

.99				sec
				.LIST ON
XRW.ReadAddr.RTS
				rts
				.LIST OFF
*--------------------------------------
XRW.TrackSelect	lda #2
				sta XRW.BadSeekCnt

.1				stz XRW.RetryCnt

.2  			jsr XRW.ReadAddr
				bcc .4

.3  			inc XRW.RetryCnt
				bpl .2

				jsr XRW.Recalibrate
				bcc .1

				rts
*--------------------------------------
.4  			ldx XRW.UnitIndex

				lda XRW.AddrField.V
				sta XRW.D2VolNum-1,x

				lda XRW.AddrField.T
				sta XRW.D2Trk-1,x
				eor XRW.ReqTrack
				beq .8

				lda XRW.AddrField.V
				asl
				bcc .5					single sided

				bmi .5					> 192 ????

				lda XRW.ReqTrack
				and #1

				rol						A = 0/2

				ora ZP.A2L
				tay						y = n0/n2

				lda IO.D2.Ph0On,y		PhOn 0/2 for Head0 or 1/3 for Head1
				lda IO.D2.Ph0On+4,y

				jsr XRW.Wait100usec

				jsr XRW.AllPhOff

				lda XRW.AddrField.T
				sta XRW.D2Trk-1,x
				bra .1

.5				lda XRW.AddrField.T
				cmp XRW.ReqTrack
				beq .8

				lda XRW.BadSeekCnt
				beq .6					2 bad seeks, already

				dec XRW.BadSeekCnt
				bne .7

.6				lda XRW.SeekTime
				clc
				adc #IO.D2.SeekTimeI
				bmi .7					seektime  > 128

				sta XRW.SeekTime
				sta XRW.D2SeekTime-1,x

.7				ldy XRW.D2Trk-1,x		From actual Pos...
				lda XRW.ReqTrack		....to Req
				jsr XRW.SeekYA			X = XRW.UnitIndex

				bra .3

.8				clc
XRW.TrackSelect.RTS
				rts
*--------------------------------------
XRW.Recalibrate	sec
				dec XRW.RecalibrateCnt
				beq XRW.TrackSelect.RTS

				ldx XRW.UnitIndex

				ldy #40					from 40... (4/4)
				lda #0					....to 0
				sta XRW.D2VolNum-1,x	reset volnum for seeking 40->0 4/4 tracks
*--------------------------------------
XRW.SeekYA		sta XRW.D2Trk-1,x		will be current track at the end

				jsr XRW.Trk2Qtrk
				sta XRW.TargetQTrack

				tya

				jsr XRW.Trk2Qtrk
				sta XRW.CurrentQTrack

				bit #1					A = Current QT
				beq .2					we are on 0/4 or 2/4 track

				pha
	
				cmp	XRW.TargetQTrack	we are on 1/4 or 3/4 track
				bcc .1					if CC, C < T, must move in
				
				inc						move out: X = Ph(N+1)
				
.1				jsr XRW.SeekPhOnY		move in : X = Ph(N)

				tya
				tax				
				
				pla
				
				bcs .2					if CS, C > T, must move out

				inc						move in : Y = Ph(N+1)

.2				jsr XRW.SeekPhOnY		move out: Y = Ph(N)

				bra .9					Ph ON to go to 0/4 or 2/4, no wait
*--------------------------------------
.3				bcs	.4					if CS, C > T, must move out

				inc						CC: C < T, ON next PH

				.HS B0					BCS

.4				dec						CS: C > T, ON prev PH

				sta XRW.CurrentQTrack

				bit #1					C = xxxxxxx1 ?
				bne .5					yes, 2 PhOn required

				lda IO.D2.Ph0Off,x		we must go to 0/4 or 2/4 : PhX Off
				bra .8					go wait....

.5				phy						we must go on 1/4 or 3/4
				plx						Y already ON, -> X for Ph0Off,x

				bcs	.6					if CS, C > T, must move out

				inc						CC: C < T, ON next PH

.6				jsr XRW.SeekPhOnY		now X and Y on

.8				lda XRW.SeekTime

				jsr XRW.Wait100usecA	...wait...

.9				lda XRW.CurrentQTrack
				cmp	XRW.TargetQTrack
				bne .3

*				lsr						CS if X,Y on

				jsr XRW.Wait25600usec

XRW.AllPhOff	ldy ZP.A2L
				lda IO.D2.Ph0Off,y
				lda IO.D2.Ph0Off+2,y
				lda IO.D2.Ph0Off+4,y
				lda IO.D2.Ph0Off+6,y
				

*				lda IO.D2.Ph0Off,y

*				bcc .10

*				lda IO.D2.Ph0Off,x
				clc						Exit wit CC (recalibrate)
*				lda IO.D2.Ph0Off,y
				
.10				rts
*--------------------------------------
XRW.SeekPhOnY	and #6
				ora ZP.A2L
				tay
				lda IO.D2.Ph0On,y
				rts
*--------------------------------------
* In:
*  A = Logical Track 0 -> 159,
*  X = XRW.UnitIndex
*  D2VolNum : d0000sss
* Out:
*  A =
*--------------------------------------
XRW.Trk2Qtrk	sta ZP.PCH

				lda XRW.D2VolNum-1,x
				bne .1

.10				lda ZP.PCH				standard SS 4 qtrack stepping
				asl
				asl
				rts

.1				bpl .2

				cmp #$85
				bcs .10					> 192 ? must be a buggy 254

				lsr ZP.PCH				2 sides

.2				phx
				and #%00000111			stepping
				tax

				lda #0
				clc

.3				adc ZP.PCH
				dex
				bne .3

				plx

.8				rts
*--------------------------------------
* preniblize subroutine (16 sector format)
*
* converts 256 bytes of user data in (buf) into 6 bit nibls in nbuf2.
* high 6 bits are translated directly by the write routines.
*
* on entry: buf is 2-byte pointer to 256 bytes of user data.
*
* on exit: a,x,y undefined. write routine modified to do direct conversion
* of high 6 bits of user's buffer data.
*--------------------------------------
XRW.PreNibble	lda ZP.BUFPTR			self-modify the addresses because of
				ldy ZP.BUFPTR+1			the fast timing required.

				clc		  				all offsets are minus $AA.
				adc #$02	  			the highest set is buf+$AC.
				bcc L58FA				branch if no carry,

				iny		  				otherwise add carry to high address.

L58FA 			sta prn3+1	   			self mod 3
				sty prn3+2

				sec
				sbc #$56				middle set is buf+$56.
				bcs L5906				branch if no borrow,

				dey		  				otherwise deduct from high.

L5906  			sta prn2+1				self mod 2
				sty prn2+2

				sec
				sbc #$56				low set is exactly buf
				bcs L5912

				dey

L5912  			sta prn1+1				self mod 1
				sty prn1+2

				ldy #$AA				count up to 0.

prn1			lda $1000,y				warning: self modified. get byte from lowest group.
				and #$03	   			strip high 6 bits.
				tax		  				index to 2 bit equivalent.
				lda XRW.0000XX00,x
				pha		  				save pattern

prn2			lda $1056,y				warning: self modified. get byte from middle group.
				and #$03
				tax
				pla		  				restore pattern.
				ora XRW.00XX0000,x  	combine 2nd group with 1st.
				pha		  				save new pattern.

prn3			lda $10AC,y				warning: self modified. get byte from highest group.
				and #$03
				tax
				pla		  				restore new pattern
				ora XRW.XX000000,x 		and form final nibl.
				pha

				tya
				eor #$FF
				tax

				pla
				sta nbuf2,x	  			save in nibl buffer.
				iny		  				inc to next set.
				bne prn1				loop until all $56 nibls formed.

				ldy ZP.BUFPTR			now prepare data bytes for write16 subr.
				dey		  				prepare end address.
				sty ZP.A2H
				lda ZP.BUFPTR
				sta wrefd1+1			warning: the following storage addresses
				beq L595F				starting with 'wref' are refs into code

				eor #$FF	   			space, changed by this routine.
				tay		  				index to last byte of page in (buf).
				lda (ZP.BUFPTR),y	 	pre-niblize the last byte of the page
				iny		  				with the first byte of the next page.
				eor (ZP.BUFPTR),y
				and #$FC
				tax
				lda XRW.FC2Nib,x	  	get disk 7-bit nible equivalent.

L595F  			sta ZP.PCH
				beq L596F				branch if data to be written is page aligned.

				lda ZP.A2H				check if last byte is even
				lsr						or odd address. shift even/odd -> carry.
				lda (ZP.BUFPTR),y		if even, then leave intact.
				bcc L596D				branch if odd.

				iny		  				if even, then pre-xor with byte 1.
				eor (ZP.BUFPTR),y
L596D  			sta ZP.A1L				save result for write routine.

L596F  			ldy #$FF	   			index to last byte of data to write.
				lda (ZP.BUFPTR),y		to be used as a checksum.
				and #$FC	   			strip extra bits
				sta ZP.A1H				and save it.

				ldy ZP.BUFPTR+1			now modify address references to
				sty wrefa1+2	   		user data.
				sty wrefa2+2

				iny
				sty wrefa3+2
				sty wrefa4+2
				sty wrefa5+2
				sty wrefa6+2

				ldx ZP.A2L				and lastly, index references to
				stx wrefd2+1	   		controller.
				stx wrefd3+1
				stx wrefd4+1
				stx wrefd5+1
				rts
*--------------------------------------
				.LIST ON
XRW.FREE		.EQ $D540-*
				.LIST OFF
				.BS $D540-*
*--------------------------------------
* nibl buffer 'nbuf2' must fit in a page
*--------------------------------------
nbuf2			.BS $56		 			nibl buffer for read/write of low 2-bits of each byte.
*--------------------------------------
* 7-bit to 6-bit 'deniblize' table (16-sector format)
*
* valid codes are $96 to $FF only. codes with more than one pair of
* adjacent zeroes or with no adjacent ones (except bit 7) are excluded.
*
* nibbles in the ranges of $A0-$A3, $C0-$C7, $E0-$E3 are used for
* other tables since no valid nibbles are in these ranges.
* aligned to page boundary + $96
*--------------------------------------
XRW.Nib2FC		.HS 0004
*				.HS FFFF
XRW.UnitIndex		.HS 00
XRW.LastUnitUsed	.HS 00
				.HS 080C
*				.HS FF
XRW.RecalibrateCnt	.HS 00
				.HS 101418
XRW.XX000000	.HS 008040C0			used in fast prenib as lookup for 2-bit quantities.
*				.HS FFFF
XRW.montimel 		.HS 00
XRW.montimeh 		.HS 00
				.HS 1C20
				.HS FFFFFF
				.HS 24282C3034
*				.HS FFFF
XRW.ReqTrack		.HS 00
XRW.ReqSector		.HS 00
				.HS 383C4044484C
*				.HS FF
XRW.BadSeekCnt		.HS 00
				.HS 5054585C606468
XRW.00XX0000	.HS 00201030			used in fast prenib.
XRW.EndMark		.HS EBAADE		  		table using 'unused' nibbles ($C4,$C5,$C6,$C7)
*				.HS FFFFFFFF
XRW.AddrField.C		.HS 00				AddrField Checksum
XRW.AddrField.S		.HS 00				AddrField Sector
XRW.AddrField.T		.HS 00				AddrField Track
XRW.AddrField.V		.HS 00				AddrField Volume
				.HS 6C
XRW.SeekTime		.HS 00
*ibstat				.HS 00
				.HS 707478
				.HS FFFFFF
				.HS 7C
*				.HS FFFF
XRW.Temp4x4			.HS 00
XRW.CheckSum		.HS 00 				used for address header cksum
				.HS 8084
				.HS FF
				.HS 888C9094989CA0
XRW.0000XX00	.HS 0008040C			used in fast prenib.
*				.HS FF
XRW.CurrentQTrack	.HS 00
				.HS A4A8AC
*				.HS FF
XRW.TargetQTrack	.HS 00
				.HS B0B4B8BCC0C4C8
*				.HS FFFF
XRW.RetryCnt		.HS 00
				.HS 00
				.HS CCD0D4D8DCE0
XRW.bWrite			.HS 00
				.HS E4E8ECF0F4F8FC
*--------------------------------------
* 6-bit to 2-bit conversion tables:
*
* origin = $D600 (page boundary)
*
* dnibl2 abcdef-->0000FE
* dnibl3 abcdef-->0000DC
* dnibl4 abcdef-->0000BA
* page align the following tables:
*--------------------------------------
* FC-bits to nibble conversion table (256 bytes)
*
* codes with more than one pair of adjacent zeroes
* or with no adjacent ones (except B7) are excluded.
*--------------------------------------
dnibl2			.HS 00
dnibl3			.HS 00
dnibl4			.HS 00
XRW.FC2Nib		.HS 96
				.HS 02000097
				.HS 0100009A
				.HS 0300009B
				.HS 0002009D
				.HS 0202009E
				.HS 0102009F
				.HS 030200A6
				.HS 000100A7
				.HS 020100AB
				.HS 010100AC
				.HS 030100AD
				.HS 000300AE
				.HS 020300AF
				.HS 010300B2
				.HS 030300B3
				.HS 000002B4
				.HS 020002B5
				.HS 010002B6
				.HS 030002B7
				.HS 000202B9
				.HS 020202BA
				.HS 010202BB
				.HS 030202BC
				.HS 000102BD
				.HS 020102BE
				.HS 010102BF
				.HS 030102CB
				.HS 000302CD
				.HS 020302CE
				.HS 010302CF
				.HS 030302D3
				.HS 000001D6
				.HS 020001D7
				.HS 010001D9
				.HS 030001DA
				.HS 000201DB
				.HS 020201DC
				.HS 010201DD
				.HS 030201DE
				.HS 000101DF
				.HS 020101E5
				.HS 010101E6
				.HS 030101E7
				.HS 000301E9
				.HS 020301EA
				.HS 010301EB
				.HS 030301EC
				.HS 000003ED
				.HS 020003EE
				.HS 010003EF
				.HS 030003F2
				.HS 000203F3
				.HS 020203F4
				.HS 010203F5
				.HS 030203F6
				.HS 000103F7
				.HS 020103F9
				.HS 010103FA
				.HS 030103FB
				.HS 000303FC
				.HS 020303FD
				.HS 010303FE
				.HS 030303FF
*--------------------------------------
				.EP
*--------------------------------------
				.LIST ON
XRW.LEN			.EQ *-XRW.START
				.LIST OFF
*--------------------------------------
MAN
SAVE usr/src/prodos.fx/prodos.s.xrw
LOAD usr/src/prodos.fx/prodos.s
ASM