A2osX/ProDOS.FX/ProDOS.S.XDOS.D.txt

NEW
  AUTO 3,1
*--------------------------------------
XDOS.Read		jsr mvdbufr				xfer buffer address and request count
				jsr mvcbytes			to a more accessable location, also
				pha		 				get fcb attributes and save on stack.
				jsr calcmrk				calc mark after read, test if mark > eof
				pla		 				carry set means end mark > eof.
				and #$01			 	test for read enabled.
				beq .9

	  			bcc L4205			  	branch if result mark < eof. adjust

				ldy fcbptr			 	request to read until just before eof.
				lda FCBs+FCB.EOF,y		result = (eof-1) - position
				sbc tposll
				sta cbytes
				sta rwreql
				lda FCBs+FCB.EOF+1,y
				sbc tposlh
				sta cbytes+1
				sta rwreqh
				ora cbytes			 	if both bytes = 0 then eof error
				bne L4210

				lda #MLI.E.EOF
				.HS 2C
.9				lda #MLI.E.LOCKED
L4202  			jmp errfix1

L4205  			lda cbytes
				ora cbytes+1
				bne L4210				if read request definitely non-zero.

L420D  			jmp rwdone			 	do nothing.

L4210  			jsr valdbuf				validate user's data buffer range.
				bcs L4202			  	branch if memory conflict.

				jsr gfcbstyp			get storage type
				cmp #$04			 	and find out if it's a tree or other.
				bcc L421F			 	branch if a tree file

				jmp XDOS.ReadDir	  	otherwise assume it's a directory.

L421F  			jsr rdposn			 	set up data pointer.
				bcs L4202			  	errors.

				jsr preprw				test for newline, setup for partial
				jsr readpart			read. move current data buffer contents
				bvs L420D				to user area. branch if satisfied.
				bcs L421F			  	indicates newline is set.

				lda rwreqh			 	how many blocks are to be read ?
				lsr			  			if < 2 then use the slow way.
				beq L421F

				sta cmdtemp				save bulk block count.
				jsr	XDOS.GetFCBStatus	make sure current data area doesn't
				and #$40				need writing before resetting ptr to
				bne L421F			  	read into user's area. branch if data

				sta ioaccess			needs to be written to force 1st call
				lda usrbuf			 	thru all dev handler checking. make
				sta datptr			 	the data buffer the user's space.
				lda usrbuf+1
				sta datptr+1

L4249  			jsr rdposn			 	get next block directly into user space.
				bcs L42B7				if error.

L424E  			inc datptr+1			incll ptrs by one block (512 bytes)
				inc datptr+1
				dec rwreqh
				dec rwreqh
				inc tposlh
				inc tposlh
				bne L4269				if pos'n doesn't get to a 64k boundary

				inc tposhi			 	otherwise, must check for a 128k one.
				lda tposhi				carry set if 128k boundary reached.
				eor #$01
				lsr

L4269  			dec cmdtemp				has all been read fast ?
				bne L427B			  	branch if more to read.

				jsr fxdatptr			go fix up data pointer to xdos buffer.
				lda rwreql			 	test for end of read.
				ora rwreqh			 	are both 0 ?
				beq rwdone			  	yes, done.
				bne L421F			  	no, read last partial block

L427B  			bcs L4249

				lda tposhi			 	get index to next block address
				lsr
				lda tposlh
				ror
				tay		 				index to address = int(pos/512)
				lda (zpt),y				get low address
				sta bloknml
				inc zpt+1
				cmp (zpt),y				are hi and low address the same?
				bne L4299			  	no, it's a real block address.

				cmp #$00			 	are both bytes 0 ?
				bne L4299			  	no, must be real data.

				sta ioaccess			don't do repeat io just after sparse.
				beq L429C			  	branch always (carry set).

L4299  			lda (zpt),y				get high address
				clc
L429C  			dec zpt+1
				bcs L4249			  	if no block to read.

				sta bloknml+1
				lda ioaccess			has 1st call gone to device yet ?
				beq L4249			  	no, go thru normal route

				lda datptr+1			reset hi buffer address for dev handler
				sta buf+1
				jsr XDOS.DevCall
				bcc L424E			  	no errors, branch always.

L42B7  			pha		 				save error code.
				jsr fxdatptr			go restore data pointers, etc.
				pla

errfix1			pha		 				save error code
				jsr rwdone			 	pass back # of bytes actually read
				pla
				sec						error
				rts
*--------------------------------------
rwdone			ldy #$06			 	return total # of bytes actually read
				sec		 				derived from cbytes-rwreq.
				lda cbytes
				sbc rwreql
				sta (A3L),y
				iny
				lda cbytes+1
				sbc rwreqh
				sta (A3L),y
				jmp rdposn			 	leave with valid position in fcb.
*--------------------------------------
preprw			ldy fcbptr			 	adj pointer to user's buffer to make
				sec		 				the transfer
				lda usrbuf
				sbc tposll
				sta usrbuf
				bcs L42E9			  	if no adjustment to hi address needed
				dec usrbuf+1

L42E9  			lda FCBs+FCB.NLMASK,y	test for new line enabled.
				clc
				beq L42F9			  	if new line not enabled.
				sec		 				carry indicates new line enabled
				sta nlmask
				lda FCBs+FCB.NLBYTE,y	move newline character to more
				sta nlchar			 	accesible spot.

L42F9  			ldy tposll				index to 1st data.
				lda datptr			 	reset low order of position pointer to
				sta sos			  		beginning of page.
				ldx rwreql			 	get low order count of requested bytes.
				rts		 				return statuses.
*--------------------------------------
readpart 		txa						x = low count of bytes to move.
				bne L430F			  	branch if request is not an even page.

				lda rwreqh			 	a call of 0 bytes should never get here!
				beq L435D				branch if nothing to do.

				dec rwreqh

L430F  			dex

L4310  			lda (sos),y				move data to user's buffer
				sta (usrbuf),y
				bcs tstnewl				test for newline 1st !

L4316  			txa		 				note: x must be unchanged from tstnewl !
				beq L4332				go see if read request is satified...

L4319  			dex		 				dec # of bytes left to move.
				iny		 				page crossed ?
				bne L4310			  	no, move next byte.

				lda sos+1			  	test for end of buffer, but first
				inc usrbuf+1			adjust user buffer pointer
				inc tposlh			 	and position
				bne L4329

				inc tposhi
L4329  			inc sos+1			  	and sos buffer high address.
				eor datptr+1			(carry is undisturbed)
				beq L4310			  	branch if more to read in buffer.
				clv		 				indicate not finished.
				bvc L4360			  	always.

L4332  			lda rwreqh
				beq L4350			  	branch if request is satisfied.
				iny		 				done with this block of data ?
				bne L4340			  	no, adjust high byte of request.
				lda sos+1			  	maybe, check for end of block buffer.
				eor datptr+1			(don't disturb carry).
				bne L4343			  	if hi count can be dealt with next time

L4340  			dec rwreqh

L4343  			dey		 				restore proper value
				bra L4319

tstnewl  		lda (sos),y				get last byte transferred again.
				and nlmask			 	only bits on in mask are significant.
				eor nlchar			 	does it match newline character?
				bne L4316			  	no, read next.

L4350  			iny		 				adjust position.
				bne L435D

				inc usrbuf+1			inc pointers
				inc tposlh
				bne L435D

				inc tposhi

L435D  			bit setvflg				(sets v flag)

L4360  			sty tposll				save low position
				bvs L4366

				inx		 				leave request as +1 for next call

L4366  			stx rwreql			 	and remainder of request count.

				php		 				save statuses
				clc		 				adjust user's low buffer address
				tya
				adc usrbuf
				sta usrbuf
				bcc L4374

				inc usrbuf+1			adjust hi address as needed.

L4374  			plp		 				restore return statuses.

setvflg	 		rts						this byte ($60) is used to set v flag.
*--------------------------------------
fxdatptr 		lda datptr			 	put current user buffer address back to normal
				sta usrbuf
				lda datptr+1
				sta usrbuf+1			bank pair byte should be moved also.

				ldx fcbptr			 	restore buffer address
				jmp XDOS.GetFCBBufX
*--------------------------------------
XDOS.ReadDir	jsr rdposn
				bcs L43B8				pass back any errors.

				jsr preprw			 	prepare for transfer.
				jsr readpart			move data to user's buffer.
				bvc XDOS.ReadDir	  	repeat until request is satisfied.

				jsr rwdone			 	update fcb as to new position.
				bcc L43B6			  	branch if done with no errors.

				cmp #MLI.E.EOF		 	was last read to end of file ?
				sec		 				anticipate some other error.
				bne L43B7			  	branch if not eof error.

				jsr svmark
				jsr zipdata				clear out data block.

				ldy #$00			 	provide dummy back pointer for future
				ldx fcbptr			 	re-position. x = hi byte of last block

L43A6  			lda FCBs+FCB.DBLK,x
				sta (datptr),y
				stz FCBs+FCB.DBLK,x		mark current block as impossible
				inx
				iny		 				inc indexes to do both hi and low bytes
				cpy #$02
				bne L43A6

L43B6  			clc		 				no error
L43B7  			rts

L43B8  			jmp errfix1				report how much xfer'd before error.
*--------------------------------------
mvcbytes 		ldy #$04				move request count to a more accessable location
				lda (A3L),y
				sta cbytes
				sta rwreql
				iny
				lda (A3L),y
				sta cbytes+1
				sta rwreqh
				ldy fcbptr			 	return y = val(fcbptr),
				lda FCBs+FCB.ACCESS,y	a = attributes
				clc		 				and carry clear...
				rts
*--------------------------------------
mvdbufr			ldy #$02			 	move the pointer to user's buffer
				lda (A3L),y				to the block file manager
				sta usrbuf			 	z-page area
				iny
				lda (A3L),y
				sta usrbuf+1

gfcbstyp 		ldy fcbptr			 	return storage type
				lda FCBs+FCB.STYPE,y
				rts
*--------------------------------------
* this subroutine adds the requested byte count to mark and returns sum
* in scrtch and also returns mark in tpos and oldmark.
*
* on exit:
*				 y,x,a is unknown
*				 carry set indicates scrtch > eof
*--------------------------------------
calcmrk			ldx #$00			 
				ldy fcbptr
				clc
L43EE  			lda FCBs+FCB.MARK,y
				sta tposll,x
				sta oldmark,x
				adc cbytes,x
				sta scrtch,x
				txa
				eor #$02				cbytes+2 always=0
				beq eoftest

				iny
				inx
				bne L43EE				always.

eoftest			lda scrtch,x			new mark in scrtch.
				cmp FCBs+FCB.EOF,y		is new position > eof ?
				bcc L4414			  	no, proceed.
				bne L4414			  	yes, adjust 'cbytes' request

				dey
				dex						all tree bytes compared ?
				bpl eoftest			  	no, test next lowest

L4414  			rts
*--------------------------------------
werreof			jsr plus2fcb			reset eof to pre-error position.

L4418  			lda oldeof,x			place oldeof back into fcb
				sta FCBs+FCB.EOF,y
				lda oldmark,x			also reset mark to last best
				sta FCBs+FCB.MARK,y		write position
				sta scrtch,x			and copy mark to scrtch for test of
				dey		 				eof less than mark.
				dex
				bpl L4418

				jsr plus2fcb			get pointers to test eof < mark.
				jsr eoftest				carry set means mark > eof !!

* drop into wadjeof to adjust eof to mark if necessary

wadjeof			jsr plus2fcb			get y=fcbptr+2, x=2, a=y.

L4434  			lda FCBs+FCB.EOF,y		copy eof to old eof
				sta oldeof,x
				bcc L4442			  	and if carry set...

				lda scrtch,x			then copy scrtch to fcb's eof.
				sta FCBs+FCB.EOF,y

L4442  			dey
				dex						copy all 3 bytes
				bpl L4434

				rts

plus2fcb 		lda #$02			 	on exit both a and y = fcbptr+2.
				tax		 				x = 2
				ora fcbptr
				tay
				rts
*--------------------------------------
XDOS.Write		jsr mvcbytes			first determine if requested write is legal.
				pha
				jsr calcmrk				save a copy of eof to old eof, set/clr
				jsr wadjeof				carry to determine if new mark > eof.
				pla		 				get attributes again.
				and #$02			 	is write enabled ?
				bne L4462			  	yes, continue...

L445E  			lda #$4E			 	illegal access error.
				bne L44A2

L4462  			jsr tstwprot			otherwise, make sure device is not
				bcs L44A2			  	write protected. if so, branch to abort.

				lda cbytes
				ora cbytes+1			anything to write ?
				bne L4472			  	branch if so,

				jmp rwdone			 	else do nothing.

L4472  			jsr mvdbufr				move the user's buffer ptr to bfm zero
				cmp #$04			 	page area, also get storage type.
				bcs L445E			  	if not tree, return an access error.

L4479  			jsr rdposn			 
				bcs L44A2

				jsr XDOS.GetFCBStatus
				and #$07
				beq L44E9

				ldy #$00				is enough disk space available for

L4487  			iny		 				indexes and data block ?
				lsr
				bne L4487

				sty reql
				sta reqh
				jsr tstfrblk
				bcs L44A2			  	pass back any errors.

				jsr XDOS.GetFCBStatus	now get more specific.
				and #$04			 	are we lacking a tree top ?
				beq L44AC			  	no, test for lack of sapling level index

				jsr topdown				go allocate tree top and adj file type.
				bcc L44B8			  	continue with allocation of data block.

L44A2  			pha		 				save error.
				jsr errfix1				error return.
				jsr werreof				adjust eof and mark to pre-error state.
				pla		 				restore error code.
				sec
				rts

L44AC  			jsr XDOS.GetFCBStatus	get status byte again.
				and #$02			 	do we need a sapling level index block ?
				beq L44B8				no, assume it's just a data block needed

				jsr sapdown				go alloc an indx blk and update tree top
				bcs L44A2				if error.

L44B8  			jsr alcwblk				go allocate for data block.
				bcs L44A2

				jsr XDOS.ClrFCBStatus	clear allocation required bits in status
				
				lda #FCB.F.IBLKMOD		indicate index block is dirty.
				jsr XDOS.SetFCBStatus
				
				lda tposhi				calculate position within index block.
				lsr
				lda tposlh
				ror
				tay						now put block address into index block.
				inc zpt+1			  	high byte first.
				lda scrtch+1
				tax
				sta (zpt),y
				dec zpt+1			  	restore pointer to lower page of index
				lda scrtch				block. get low block address.
				sta (zpt),y				store low address.

				ldy fcbptr			 	update fcb to indicate that this block
				sta FCBs+FCB.DBLK,y		is allocated.
				txa		 				get high address again.
				sta FCBs+FCB.DBLK+1,y

L44E9  			jsr preprw
				jsr wrtpart
				bvc L4479
				jmp rwdone			 	update fcb with new position

wrtpart			txa
				bne L44FF				branch if request is not even pages
				lda rwreqh			 	a call of 0 bytes should never get here!
				beq L4546				do nothing
				dec rwreqh

L44FF  			dex
				lda (usrbuf),y			move data from user's buffer
				sta (sos),y
				txa
				beq L4525

L4507  			iny		 				page crossed ?
				bne L44FF			  	no, keep moving.

				lda sos+1			  	test for end of buffer
				inc usrbuf+1			but first adjust user buffer pointer
				inc tposlh			 	and position
				bne L451C

				inc tposhi
				bne L451C

				lda #MLI.E.BEYEOF	 	out of range if > 32MB
				bne L44A2

L451C  			inc sos+1			 	adjust sos buffer high address
				eor datptr+1			(carry is undisturbed)
				beq L44FF			  	branch if more to write to buffer.

				clv		 				indicates not finished.
				bvc L4549			  	always.

L4525  			lda rwreqh
				beq L4539			  	branch if request satisfied.

				iny		 				done with this block of data ?
				bne L4533			  	if not.

				lda sos+1				this is necessary for proper
				eor datptr+1			adjustment of request count
				bne L4536

L4533  			dec rwreqh
L4536  			dey		 				reset modified y
				bra L4507

L4539  			iny		 				and position
				bne L4546

				inc usrbuf+1			inc pointers
				inc tposlh
				bne L4546

				inc tposhi

L4546  			bit setvflg				set v flag

L4549  			sty tposll			 	save low position
				stx rwreql			 	and remainder of request count.
				php		 				save statuses
				
				lda #$50
				jsr XDOS.SetFCBStatus

				clc		 				adjust user's low buffer address
				lda tposll
				adc usrbuf
				sta usrbuf
				bcc L4564

				inc usrbuf+1			adjust high address as needed.

L4564  			jsr fcbused				set directory flush bit.
				plp		 				restore return statuses
				rts

topdown			jsr swapdown			make current 1st block an entry in new
				bcs L45B1			  	top. branch if errors.

				jsr gfcbstyp			get storage type

* has storage type been changed to 'tree' ? if not, assume it was originally
* a seed and both levels need to be built. otherwise, only an index needs
* to be allocated.

				cmp #$03				tree type
				beq L457A

				jsr swapdown			make previous swap a sap level index
				bcs L45B1			  	block. branch if errors.

L457A  			jsr alcwblk				get another block address for the sap
				bcs L45B1			  	level index. branch if errors.

				lda tposhi			 	calculate position of new index block
				lsr			  			in the top of the tree.
				tay
				lda scrtch			 	get address of newly allocated index
				tax		 				block again.
				sta (zpt),y
				inc zpt+1
				lda scrtch+1
				sta (zpt),y				save hi address
				dec zpt+1
				ldy fcbptr			 	make newly allocated block the current
				sta FCBs+FCB.IBLK+1,y	index block.
				txa
				sta FCBs+FCB.IBLK,y
				jsr wfcbfst				save new top of tree
				bcs L45B1
*--------------------------------------
zeroindex 		lda #$00
				tay
L3F30  			sta (zpt),y				zero out the index half of the user's
				iny		 				i/o buffer
				bne L3F30

				inc zpt+1

L3F37  			sta (zpt),y
				iny
				bne L3F37

				dec zpt+1				restore proper address
				rts
*--------------------------------------
sapdown			jsr gfcbstyp			find out if dealing with a tree.
				cmp #$01				if seed then adj to file type is needed.
				beq swapdown			branch if seed

				jsr rfcbfst				otherwise read in top of tree.
				bcc L457A				if no error.

L45B1			rts		 				return errors.
*--------------------------------------
swapdown		jsr alcwblk				make current seed into a sapling, allocate a block before swap.
				bcs .9					return errors.

				ldy fcbptr				get previous first block
				lda FCBs+FCB.1stBLK,y	address into index block.
				pha						save temporarily while swapping in new
				lda scrtch				top index. get new block address (low)
				tax
				sta FCBs+FCB.1stBLK,y
				lda FCBs+FCB.1stBLK+1,y
				pha
				lda scrtch+1			and high address too
				sta FCBs+FCB.1stBLK+1,y
				sta FCBs+FCB.IBLK+1,y	make new top also the current index in
				txa		 				memory. get low address again.
				sta FCBs+FCB.IBLK,y
				inc zpt+1			  	make previous the 1st entry in sub index
				pla
				sta (zpt)
				dec zpt+1
				pla
				sta (zpt)
				jsr wfcbfst				save new file top.
				bcs .9				  	if error.

				lda #FCB.F.STMOD
				jsr XDOS.SetFCBStatus

				inc FCBs+FCB.STYPE,x

*				clc		 				no error
.9				rts
*--------------------------------------
alcwblk			jsr alc1blk
				bcs .9

				lda #FCB.F.UMOD
				jsr XDOS.SetFCBStatus

				inc FCBs+FCB.UBLK,x
				bne .9
				
				inc FCBs+FCB.UBLK+1,x

.9  			rts
*--------------------------------------
tstwprot		jsr XDOS.GetFCBStatus	check for 'never been modified' condition
				and #$F0
				bne tstwprot.8			ordinary rts if known write ok.

				jsr XDOS.FCBDevIDSelect

twrprot1 		sta unitnum				make the device status call

				lda bloknml+1
				pha
				lda bloknml				save the current block values
				pha
				stz A4L
				stz bloknml				zero the block #
				stz bloknml+1

				jsr XDOS.DevCall
				bcs .1					branch if write protect error

				lda #$00				otherwise, assume no errors.

.1  			plx
				stx bloknml				restore the block #
				plx
				stx bloknml+1

				rts

tstwprot.8		clc
				rts
*--------------------------------------
MAN
SAVE usr/src/prodos.fx/prodos.s.xdos.d
LOAD usr/src/prodos.fx/prodos.s
ASM