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

NEW
  AUTO 3,1
*--------------------------------------
XDOS.Read		jsr XDOS.GetUserBuf		xfer buffer address and request count
				jsr mvcbytes			to a more accessable location, also
				pha		 				get fcb attributes and save on stack.
				jsr XDOS.CalcNewMark	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 XDOS.FCBPtr			 	request to read until just before eof.
				lda XDOS.FCBs+FCB.EOF,y		result = (eof-1) - position
				sbc XDOS.TmpPos
				sta cbytes
				sta rwreql
				lda XDOS.FCBs+FCB.EOF+1,y
				sbc XDOS.TmpPos+1
				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 XDOS.GetFCB.ST		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 ZP.UserBuf			 	thru all dev handler checking. make
				sta ZP.DataPtr			 	the data buffer the user's space.
				lda ZP.UserBuf+1
				sta ZP.DataPtr+1

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

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

				inc XDOS.TmpPos+2			 	otherwise, must check for a 128k one.
				lda XDOS.TmpPos+2				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

				jsr XDOS.Tpos2Y			get index to next block address

				lda (zpt),y				get low address
				sta ZP.BLKNUM
				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 ZP.BLKNUM+1
				lda ioaccess			has 1st call gone to device yet ?
				beq L4249			  	no, go thru normal route

				lda ZP.DataPtr+1		reset hi buffer address for dev handler
				sta ZP.BUFPTR+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 (ZP.A3L),y
				iny
				lda cbytes+1
				sbc rwreqh
				sta (ZP.A3L),y
				jmp rdposn			 	leave with valid position in fcb.
*--------------------------------------
preprw			ldy XDOS.FCBPtr			 	adj pointer to user's buffer to make
				sec		 				the transfer
				lda ZP.UserBuf
				sbc XDOS.TmpPos
				sta ZP.UserBuf
				bcs .1				  	if no adjustment to hi address needed

				dec ZP.UserBuf+1

.1  			lda XDOS.FCBs+FCB.NLMASK,y	test for new line enabled.
				clc
				beq .2				  	if new line not enabled.

				sec		 				carry indicates new line enabled
				sta nlmask
				lda XDOS.FCBs+FCB.NLBYTE,y	move newline character to more
				sta nlchar			 	accesible spot.

.2  			ldy XDOS.TmpPos				index to 1st data.
				lda ZP.DataPtr			 	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 (ZP.UserBuf),y
				bcs tstnewl				test for newline 1st !

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

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 ZP.UserBuf+1			adjust user buffer pointer
				inc XDOS.TmpPos+1			 	and position
				bne L4329

				inc XDOS.TmpPos+2

L4329  			inc sos+1			  	and sos buffer high address.
				eor ZP.DataPtr+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 ZP.DataPtr+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 ZP.UserBuf+1			inc pointers
				inc XDOS.TmpPos+1
				bne L435D

				inc XDOS.TmpPos+2

L435D  			bit setvflg				(sets v flag)

L4360  			sty XDOS.TmpPos				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 ZP.UserBuf
				sta ZP.UserBuf
				bcc L4374

				inc ZP.UserBuf+1			adjust hi address as needed.

L4374  			plp		 				restore return statuses.

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

				ldx XDOS.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 XDOS.ZeroData		clear out data block.

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

L43A6  			lda XDOS.FCBs+FCB.DBLK,x
				sta (ZP.DataPtr),y
				stz XDOS.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 (ZP.A3L),y
				sta cbytes
				sta rwreql
				iny
				lda (ZP.A3L),y
				sta cbytes+1
				sta rwreqh
				ldy XDOS.FCBPtr			 	return y = val(XDOS.FCBPtr),

				lda XDOS.FCBs+FCB.ACCESS,y	a = attributes
*				clc		 				and carry clear...
				rts
*--------------------------------------
XDOS.GetUserBuf	ldy #$02			 	move the pointer to user's buffer
				lda (ZP.A3L),y				to the block file manager
				sta ZP.UserBuf			 	z-page area
				iny
				lda (ZP.A3L),y
				sta ZP.UserBuf+1

XDOS.GetFCB.ST	ldy XDOS.FCBPtr			 	return storage type
				lda XDOS.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
*--------------------------------------
XDOS.CalcNewMark
				ldx #$00			 
				ldy XDOS.FCBPtr

				clc

.1  			lda XDOS.FCBs+FCB.MARK,y
				sta XDOS.TmpPos,x
				sta oldmark,x
				adc cbytes,x
				sta scrtch,x
				txa
				eor #$02				cbytes+2 always=0
				beq eoftest

				iny
				inx
				bne .1					always.
*--------------------------------------
eoftest			lda scrtch,x			new mark in scrtch.
				cmp XDOS.FCBs+FCB.EOF,y		is new position > eof ?
				bcc .1				  	no, proceed.
				bne .1				  	yes, adjust 'cbytes' request

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

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

L4418  			lda oldeof,x			place oldeof back into fcb
				sta XDOS.FCBs+FCB.EOF,y
				lda oldmark,x			also reset mark to last best
				sta XDOS.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=XDOS.FCBPtr+2, x=2, a=y.

L4434  			lda XDOS.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 XDOS.FCBs+FCB.EOF,y

L4442  			dey
				dex						copy all 3 bytes
				bpl L4434

				rts

plus2fcb 		lda #$02			 	on exit both a and y = XDOS.FCBPtr+2.
				tax		 				x = 2
				ora XDOS.FCBPtr
				tay
				rts
*--------------------------------------
XDOS.Write		jsr mvcbytes			first determine if requested write is legal.
				pha
				jsr XDOS.CalcNewMark	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 #MLI.E.LOCKED	 	illegal access error.
				bne L44A2

L4462  			jsr XDOS.TestWP			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 XDOS.GetUserBuf		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 XDOS.CheckFree
				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
				
				jsr XDOS.Tpos2Y			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 XDOS.FCBPtr			 	update fcb to indicate that this block
				sta XDOS.FCBs+FCB.DBLK,y		is allocated.
				txa		 				get high address again.
				sta XDOS.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 (ZP.UserBuf),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 ZP.UserBuf+1			but first adjust user buffer pointer
				inc XDOS.TmpPos+1			 	and position
				bne L451C

				inc XDOS.TmpPos+2
				bne L451C

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

L451C  			inc sos+1			 	adjust sos buffer high address
				eor ZP.DataPtr+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 ZP.DataPtr+1			adjustment of request count
				bne L4536

L4533  			dec rwreqh
L4536  			dey		 				reset modified y
				bra L4507

L4539  			iny		 				and position
				bne L4546

				inc ZP.UserBuf+1			inc pointers
				inc XDOS.TmpPos+1
				bne L4546

				inc XDOS.TmpPos+2

L4546  			bit setvflg				set v flag

L4549  			sty XDOS.TmpPos			 	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 XDOS.TmpPos
				adc ZP.UserBuf
				sta ZP.UserBuf
				bcc L4564

				inc ZP.UserBuf+1			adjust high address as needed.

L4564  			jsr XDOS.SetFCB.DIRTY	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 XDOS.GetFCB.ST		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 XDOS.TmpPos+2			 	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 XDOS.FCBPtr			 	make newly allocated block the current
				sta XDOS.FCBs+FCB.IBLK+1,y	index block.
				txa
				sta XDOS.FCBs+FCB.IBLK,y
				jsr wfcbfst				save new top of tree
				bcs L45B1
*--------------------------------------
XDOS.ZeroIndex	lda #$00
				tay

				inc zpt+1
				jsr .1

				dec zpt+1

.1  			sta (zpt),y
				iny
				bne .1

				rts
*--------------------------------------
sapdown			jsr XDOS.GetFCB.ST		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 XDOS.FCBPtr				get previous first block
				lda XDOS.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 XDOS.FCBs+FCB.1stBLK,y
				lda XDOS.FCBs+FCB.1stBLK+1,y
				pha
				lda scrtch+1			and high address too
				sta XDOS.FCBs+FCB.1stBLK+1,y
				sta XDOS.FCBs+FCB.IBLK+1,y	make new top also the current index in
				txa		 				memory. get low address again.
				sta XDOS.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 XDOS.FCBs+FCB.STYPE,x

*				clc		 				no error
.9				rts
*--------------------------------------
alcwblk			jsr XDOS.GetFreeBlk
				bcs .9

				lda #FCB.F.UMOD
				jsr XDOS.SetFCBStatus

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

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

				jsr XDOS.FCBDevIDSelect

XDOS.TestWPA	sta ZP.UNITNUM			make the device status call

				lda ZP.BLKNUM
				pha
				lda ZP.BLKNUM+1			save the current block values
				pha
				stz ZP.CMDNUM
				stz ZP.BLKNUM			zero the block #
				stz ZP.BLKNUM+1

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

				lda #$00				otherwise, assume no errors.

.1  			jmp XDOS.PopBlkNumRTS	restore the block #
*--------------------------------------
XDOS.Tpos2Y		lda XDOS.TmpPos+2	 	get index to next block address
				lsr
				lda XDOS.TmpPos+1
				ror
				tay		 				index to address = int(pos/512)
XDOS.Tpos2Y.RTS	rts
*--------------------------------------
MAN
SAVE usr/src/prodos.fx/prodos.s.xdos.d
LOAD usr/src/prodos.fx/prodos.s
ASM