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

NEW
  AUTO 3,1
*--------------------------------------
XDOS.DeallocAX	stx bmcnt				high address of block.
				pha						save low address.
				ldx vcbptr			 	check that bitmap block address is
				lda VCBs+VCB.TBLK+1,x	valid given the total # of blocks
				cmp bmcnt			  	on the volume.
				pla
				bcc L3C8C			 	branch if invalid

				tax
				and #$07			 	bit to be or'd in
				tay
				lda whichbit,y			(shifting takes 7 bytes, but is slower)
				sta nofree			 	save bit pattern.
				txa		 				low block address.
				lsr bmcnt
				ror			  			get pointer to byte in block that
				lsr bmcnt			  	represents the block address.
				ror
				lsr bmcnt
				ror
				sta bmptr			  	save pointer.
				lsr bmcnt			  	transfer bit which is page of bitmap
				rol half
				jsr fndbmap				make sure device is correct one.
				bcs L3C8B			  	error.

				lda bmacmap				current map.
				cmp bmcnt			  	is in-core bitmap the correct one ?
				beq L3C64			  	branch if yes.

				jsr upbmap			 	put current map away.
				bcs L3C8B			  	error.

				lda bmcnt			  	get map #
				ldx vcbptr

				sta VCBs+VCB.BMAPIDX,x	and make it current.
				lda bmadev
				jsr gtbmap				read it into buffer
				bcs L3C8B

L3C64  			ldy bmptr			  	index to byte
				lsr half
				lda nofree			 	(get indiviual bit)
				bcc bmbufhi			  	branch if on page 1 of bitmap

				ora bmbuf+$100,y
				sta bmbuf+$100,y
				bcs L3C7D			  	always.

bmbufhi			ora bmbuf,y				this address + 2 is used as an absolute reference to bmbuf high byte.
				sta bmbuf,y

L3C7D  			lda #$80				mark bitmap as modified
				tsb	bmastat

				inc deblock				inc count of blocks deallocated
				bne L3C8A

				inc deblock+1

L3C8A  			clc
L3C8B  			rts

L3C8C  			lda #MLI.E.BADFS	 	bitmap block # impossible.
				sec		 				bitmap disk address wrong
				rts		 				(maybe data masquerading as indx block)
*--------------------------------------
alc1blk			jsr fndbmap				get address of bitmap.
				bcs L3CB8			  	error.

L3C95  			ldy #$00			 	begin search at start of bitmap block.
				sty half			 	which half (page) to search

L3C9A  			lda bmbuf,y
				bne L3CB9			  	free blocks indicated by 'on' bits

				iny
				bne L3C9A			  	check all in 1st page.

				inc half			 	now search page 2.
				inc basval			 	base value = base address / 2048.

L3CA8  			lda bmbuf+$100,y		search 2nd half for free block
				bne L3CB9

				iny
				bne L3CA8

				inc basval			 	add 2048 offset for next page.
				jsr nxtbmap				get next bitmap (if exists) and
				bcc L3C95			  	update vcb. branch if no error.

L3CB8  			rts		 				return error.

L3CB9  			sty bmptr			  	save index pointer to valid bit group.
				lda basval			 	prep for block address calculation
				sta scrtch+1
				tya		 				address of bit pattern.
				asl			  			multiply this and basval by 8
				rol scrtch+1
				asl
				rol scrtch+1
				asl
				rol scrtch+1
				tax		 				low address within 7 of actual address
				sec
				lda half
				beq L3CDB				branch if allocating from 1st half.

				lda bmbuf+$100,y		get pattern from 2nd page.
				bcs L3CDE			  	always.

L3CDB  			lda bmbuf,y				get bit pattern from 1st page.
L3CDE  			rol			  			find left most 'on' bit
				bcs L3CE4			  	if found.

				inx		 				adjust low address.
				bne L3CDE			  	always.

L3CE4  			lsr			  			restore pos'n of all but left most bit.
				bcc L3CE4			  	loop until mark moves into carry.

				stx scrtch			 	save low address.
				ldx half			 	which half of bitmap ?
				bne L3CF4			  	if page 2.

				sta bmbuf,y
				beq L3CF7			  	always.

L3CF4  			sta bmbuf+$100,y		update to show allocated block in use.

L3CF7  			lda #$80			 	indicate map is modified.
				tsb bmastat

				ldx vcbptr			 	subtract 1 from total free vcb blocks
				lda VCBs+VCB.FBLK,x			to account for newly allocated block.
				bne .7
				dec	VCBs+VCB.FBLK+1,x
.7				dec	VCBs+VCB.FBLK,x
				
				lda scrtch			 	return address in y,a of newly
				ldy scrtch+1			allocated block.
				clc		 				no errors.
				rts
*--------------------------------------
nxtbmap			ldx vcbptr			 	inc to next bitmap, but 1st make sure there is another one.
				lda VCBs+VCB.TBLK+1,x
				lsr
				lsr
				lsr
				lsr
				cmp VCBs+VCB.BMAPIDX,x	are there more maps ?
				beq L3D60			  	if no more to look at.

				inc VCBs+VCB.BMAPIDX,x	add 1 to current map
				jsr upbmap

fndbmap			ldy vcbptr
				lda VCBs+VCB.DEV,y		get device #.
				cmp bmadev				does this map match this device ?
				beq L3D4A			  	yes.

				jsr upbmap			 	otherwise, save other volume's bitmap
				bcs L3D5F

				ldy vcbptr
				lda VCBs+VCB.DEV,y
				sta bmadev			 	and read in fresh bitmap for this dev.

L3D4A  			ldy bmastat				is it already modified ?
				bmi L3D54			  	yes, return pointer

				jsr gtbmap			 	otherwise read in fresh bitmap.
				bcs L3D5F			  	if error.

L3D54  			ldy vcbptr			 	get relative block # of bitmap.
				lda VCBs+VCB.BMAPIDX,y
				asl			  			2 pages per block
				sta basval

				clc		 				no errors.
L3D5F  			rts

L3D60  			lda #MLI.E.VOLFULL	 	request can't be filled
				sec		 				error
				rts
*--------------------------------------
upbmap			clc		 
				lda bmastat				is current map modified ?
				bpl .9				  	no.

				jsr wrtbmap				update device.
				bcs .9				  	if error on writing.

				stz bmastat				mark bitmap buffer as free
			lda #0						MUST EXIT WITH A=0
.9				rts
*--------------------------------------
gtbmap			sta bmadev			 	read bitmap specified by dev and vcb.

				ldy vcbptr			 	get lowest map # with free blocks in it
				lda VCBs+VCB.BMAPIDX,y
				sta bmacmap				associate offset with bitmap ctrl block.
				clc						add this # to the base address of
				adc VCBs+VCB.BMAP,y		1st bitmap and save in bmadadr which
				sta bmadadr				is address of bitmap to be used.

				lda VCBs+VCB.BMAP+1,y
				adc #$00
				sta bmadadr+1

				lda #$01			 	read device command
				.HS 2C					BIT ABS
wrtbmap			lda #$02			 	write command.
				
				sta A4L

				lda devnum			 	save current dev #
				pha
				lda bmadev			 	get bitmap's dev #
				sta devnum
				lda bmadadr				and disk address
				sta bloknml
				lda bmadadr+1
				sta bloknml+1

				lda /bmbuf
*				lda bmbufhi+2			address of the buffer (low = 0)
				jsr XDOS.RWBlock

				plx						keep A=error code if CS
				stx devnum

L3DB6  			rts
*--------------------------------------
				.DO LOWERCASE=1
XDOS.WriteGBufDir
				jsr XDOS.PackGBuf
				bra XDOS.WriteGBuf
				.FIN
*--------------------------------------
XDOS.ReadGBuf_d_frst
				lda d_frst			 	read 1st block of directory into gbuf
				ldx d_frst+1
				.DO LOWERCASE=1
XDOS.ReadGBufAXDir				
				jsr XDOS.ReadGBufAX
				bcc XDOS.UnpackGBuf
				rts
				.FIN
XDOS.ReadGBufAX	sta bloknml
				stx bloknml+1

XDOS.ReadGBuf	lda #$01			 	read command.
				.HS 2C					BIT ABS

XDOS.WriteGBuf	lda #$02				write command

				sta A4L			  		pass to device handler.
				lda /gbuf			 	general buffer.

XDOS.RWBlock	sta buf+1				buffer high.
				stz buf			  		buffer low (always on page boundary)

				stz p8error				clear global error code.

				lda #$FF			 	indicates reg call made to dev handler
				sta ioaccess

				lda devnum			 	transfer dev # for dispatcher to
				sta unitnum				convert to unit #.
				jmp XDOS.DevCall	 	call the driver.
*--------------------------------------
				.DO LOWERCASE=1

XDOS.CheckAndUnpackGBuf
				lda gbuf+$23
				sta h_entln
				ldy gbuf+$24
				sty h_maxent
				cmp #$27
				bne .9
				
				cpy #$0D
				beq XDOS.UnpackGBuf

.9				lda	#MLI.E.NOTPRODOS
				sec
				rts

XDOS.UnpackGBuf	jsr XDOS.Pack.Init
				
.1				lda (zpt)
				and #$0F
				beq .6
				
				ldy #$1D				MIN_VERSION
				lda (zpt),y
				bpl .6					no lowercase information
				
				lda (zpt)
				and #$0F
				tay

.2				cpy #8					CS if MIN_VERSION to use
				phy
				
				bcs .3

				ldy #$1D				MIN_VERSION
				lda (zpt),y
				
				ply
				and whichbit,y
				beq .5

				bra .4
				
.3				ldy #$1C				VERSION
				lda (zpt),y
				
				ply
				and whichbit-8,y
				beq .5

.4				lda (zpt),y
				eor #$20				to lowercase
				sta (zpt),y
				
.5				dey
				bne .2
						
.6				jsr XDOS.Pack.Next
				dex				
				bne .1
				
				clc						make sure CC
				rts
*--------------------------------------
*XDOS.PackGBuf.Bitmap .BS 2
XDOS.PackGBuf.Bitmap .EQ sos
*--------------------------------------
XDOS.PackGBuf	jsr XDOS.Pack.Init

.1				lda (zpt)
				and #$0F
				beq .6

				stz XDOS.PackGBuf.Bitmap
				stz XDOS.PackGBuf.Bitmap+1

				tay

.2				lda (zpt),y

				cmp #'a'
				bcc .5

				cmp #'z'+1
				bcs .5

				eor #$20				to uppercase
				sta (zpt),y
				
				cpy #8					CS if MIN_VERSION to use
				bcs .3

				lda whichbit,y
				tsb XDOS.PackGBuf.Bitmap+1
				bra .4
				
.3				lda whichbit-8,y
				tsb XDOS.PackGBuf.Bitmap
				
.4				lda #$80
				tsb XDOS.PackGBuf.Bitmap+1
				
.5				dey
				bne .2
				
				ldy #$1C				VERSION
				lda XDOS.PackGBuf.Bitmap
				sta (zpt),y

				iny 					MIN_VERSION
				lda XDOS.PackGBuf.Bitmap+1
				sta (zpt),y
						
.6				jsr XDOS.Pack.Next
				dex				
				bne .1
				
				rts
*--------------------------------------
XDOS.Pack.Init	lda #4
				sta zpt
				lda /gbuf
				sta zpt+1
				
				ldx h_maxent
*			beq *						DEBUG : should never happends
				rts
*--------------------------------------
XDOS.Pack.Next	lda h_entln
				clc
				adc zpt
				sta zpt
				bcc .8
				
				inc zpt+1
				
.8				rts				
				.FIN
*--------------------------------------
XDOS.GetMark	ldx fcbptr				index to open fcb.

				ldy #$02				index to user's mark parameter.

.1				lda FCBs+FCB.MARK,x		transfer current position
				sta (A3L),y				to user's parameter list
				inx
				iny
				cpy #$05				transfer 3 bytes
				bne .1

				clc
				rts

L3DFD  			lda #MLI.E.BEYEOF		invalid position
				sec
				rts
*--------------------------------------
XDOS.SetMark	ldy #$04				index to user's desired position.
				ldx fcbptr				file's control block index.
				inx						inc by 2 for index to hi eof
				inx
				sec						indicate comparisons are necessary.

.1				lda (A3L),y				move it to 'tpos'
				sta tposll-2,y
				bcc .2					branch if mark < eof

				cmp FCBs+FCB.EOF,x
				bcc .2					branch if mark qualifies.

				bne L3DFD				branch if mark > eof (invalid position)

				dex

.2				dey		 				move/compare next lower byte of mark.
				tya						test for all bytes moved/tested.
				eor #$01				preserves carry status.
				bne .1					branch if more.

rdposn			ldy fcbptr				test to see if new position is
				lda FCBs+FCB.MARK+1,y	within the same (current) data block.
				and #$FE
				sta scrtch
				lda tposlh				middle byte of new position
				sec
				sbc scrtch
				sta scrtch
				bcc L3E44				branch if < current position.

				cmp #$02				must be within 512 bytes of beginning
				bcs L3E44				of current position.

				lda tposhi				make sure within the same 64k.
				cmp FCBs+FCB.MARK+2,y
				bne L3E44				branch if not.

				jmp	svmark				if so, adj fcb, position ptr and return.

L3E44			lda FCBs+FCB.STYPE,y	determine file type for positioning.
				beq L3E50				0 = invalid file type.

				cmp #$04				tree class file?
				bcc L3E59				yes, go position.

				jmp dirmark				no, test for dir type.

L3E50  			ldy #$A4				clear illegal filetype entry in fcb
				sta FCBs,y
				lda #MLI.E.BADREF	 	and report error
				sec
				rts

L3E59  			lda FCBs+FCB.STYPE,y	use storage type as # of index levels
				sta levels			 	since 1=seed, 2=sapling, 3=tree.
				lda FCBs+FCB.F,y
				and #FCB.F.DBLKMOD	 	if previous data was modified then
				beq L3E6B			  	disk must be updated.

				jsr wfcbdat

				bcs L3ED4				if error.

L3E6B  			ldy fcbptr				test to see if current index block
				lda FCBs+FCB.MARK+2,y	is usable by checking if new
				and #$FE			 	position is within 128k of the
				sta scrtch			 	beginning of current sapling level
				lda tposhi			 	chunk.
				sec
				sbc scrtch
				bcc L3E9D				branch if a new index block is needed.

				cmp #$02				is new position within 128k of old ?
				bcs L3E9D				branch if not.

				ldx levels				is it a seed file ?
				dex
				bne datlevel1			no, use current indexes.

L3E89  			lda tposlh				is new position < 512 ?
				lsr
				ora tposhi
				bne L3EEF				no, mark both data and index block as

				lda FCBs+FCB.1stBLK,y	unallocated. 1st block is only block
				sta bloknml				and it's data.
				lda FCBs+FCB.1stBLK+1,y		high block address.
				jmp rnewpos				go read in block and set statuses.

L3E9D  			lda FCBs+FCB.F,y		check to see if previous index block
				and #FCB.F.IBLKMOD		was modified.
				beq L3EA9				read in over it if current up to date.

				jsr wfcbidx				go update index on disk (fcb block addr)
				bcs L3ED4

L3EA9  			ldx levels				be sure there is a top index
				cpx #$03			 	before reading it...
				beq posindex			branch if file is a tree.

				lda tposhi			 	is new position within range of a
				lsr			  			sapling file (less than 128k) ?
				php		 				save results
				lda #$07			 	(no level is allocated for new pos'n)
				plp		 				restore z-flag.
				bne L3F18			  	go mark all as dummy.

				jsr XDOS.ClrFCBStatus	clr status bits 0,1,2 (index/data/alloc)

				dex						check for seed
				beq L3E89			  	if seed, check for position < 512.

				jsr rfcbfst				go get only index block.
				bcs L3ED4			  	if error.

				ldy fcbptr			 	save newly loaded index block's address.
				lda bloknml
				sta FCBs+FCB.IBLK,y
				lda bloknml+1
				sta FCBs+FCB.IBLK+1,y
datlevel1		bra datlevel			branch always

L3ED4  			rts

posindex 		jsr XDOS.ClrFCBStatus	clr all alloc requirements for previous
				jsr rfcbfst				position. get highest level index block
				bcs L3ED4

				lda tposhi			 	then test for a sap level index block
				lsr
				tay
				lda (zpt),y
				inc zpt+1
				cmp (zpt),y				(both high and low = 0 if no index exists)
				bne saplevel

				tax		 				are both bytes 0 ?
				bne saplevel

				dec zpt+1

L3EEF  			lda #$03				show neither index or data block alloc'd
				bra L3F18

saplevel 		sta bloknml				read in next lower index block.
				lda (zpt),y				(high address)
				sta bloknml+1
				dec zpt+1
				
*				jsr rfcbidx				read in sapling level
				
				lda #$01			 	prepare to read index block : read command
				sta A4L

				ldx #zpt			 	address of current index buffer.

				jsr fileio1				go read index block.
				bcs L3ED4			 	error

				ldy fcbptr
				lda bloknml
				sta FCBs+FCB.IBLK,y		save block address of this index in fcb
				lda bloknml+1
				sta FCBs+FCB.IBLK+1,y

datlevel 		lda tposhi				get block address of data block
				lsr
				lda tposlh			 	( if there is one )
				ror
				tay
				lda (zpt),y				data block address low
				inc zpt+1
				cmp (zpt),y
				bne L3F51

				tax
				bne L3F51

				lda #$01				show data block as never been allocated
				dec zpt+1

L3F18  			jsr XDOS.SetFCBStatus	set status to show what's missing

				lsr			  			discard bit that says data block
				lsr			  			unallocated because carry indicates if
				jsr zipdata				index block is invalid and needs to be zeroed.
				bcc svmark			  	branch if it doesn't need zeroed

				jsr zeroindex			zero index block in user's i/o buffer
				bra svmark
*--------------------------------------
zipdata			lda #$00
				tay
L3F42  			sta (datptr),y			zero out data area
				iny
				bne L3F42

				inc datptr+1

L3F49  			sta (datptr),y
				iny
				bne L3F49

				dec datptr+1
				rts
*--------------------------------------
L3F51  			sta bloknml				get data block of new position
				lda (zpt),y				(high address)
				dec zpt+1

rnewpos			sta bloknml+1
				jsr XDOS.ReadFCB.DBLK
				bcs L3F86				if error.

				jsr XDOS.ClrFCBStatus	show whole chain is allocated.
*--------------------------------------
svmark			ldy fcbptr			 	update position in fcb
				iny
				iny
				ldx #$02

L3F68  			lda FCBs+FCB.MARK,y		save old mark in case calling routine
				sta oldmark,x			fails later.
				lda tposll,x
				sta FCBs+FCB.MARK,y
				dey
				dex		 				move 3 byte position marker
				bpl L3F68

				clc		 				set up indirect address to buffer
				lda datptr			 	page pointed to by the current
				sta sos			  		position marker.
				lda tposlh
				and #$01
				adc datptr+1
				sta sos+1
L3F86  			rts						carry set if error
*--------------------------------------
dirmark			cmp #$0D				is it a directory ?
				beq L3F9C			  	yes...

				lda #MLI.E.INCFF	 	no, so compatability problem.
				jsr GP.P8errv		 	should not have been opened !!!

L3F9C  			lda scrtch			 	recover results of previous subtraction.
				lsr						use difference as counter for how many
				sta cntent			 	blocks must be read to get to new pos'n.

				lda FCBs+FCB.MARK+1,y	test for positive direction
				cmp tposlh			 	indicated by carry.

				lda FCBs+FCB.MARK+2,y
				sbc tposhi

				bcc L3FB9			  	if set, position forward. otherwise,

L3FAB  			ldy #$00			 	read directory file in reverse order.
				jsr dirpos1				read previous block.
				bcs L3FD6			  	if error.

				inc cntent				count up to 128.
				bpl L3FAB			  	loop if more blocks to pass over.

				bmi svmark			  	always.

L3FB9  			ldy #$02			 	position is forward from current.
				jsr dirpos1				read next directory block
				bcs L3FD6			  	if error.

				dec cntent
				bne L3FB9			  	loop if position not found in this block

				beq svmark			  	branch always.
*--------------------------------------
dirpos1			lda (datptr),y			get link address of previous or next
				sta bloknml				directory block.
				cmp #$01			 	test for null byte into carry
				iny		 				but first be sure there is a link.
				lda (datptr),y			get the rest of the link.
				bne L3FD8			  	branch if certain link exists.

				bcs L3FD8			  	was the low part null as well ?

				lda #MLI.E.EOF		 	something is wrong with directory file!
L3FD6  			sec						error.
				rts

L3FD8  			sta bloknml+1
*--------------------------------------
XDOS.ReadFCB.DBLK
				lda #$01				read command
				sta A4L

				ldx #datptr				points at address  of data buffer.

				jsr fileio1				go do file input.
				bcs L3FF2			  	error.

				ldy fcbptr
				lda bloknml
				sta FCBs+FCB.DBLK,y		save block # just read in fcb.
				lda bloknml+1
				sta FCBs+FCB.DBLK+1,y

*				clc

L3FF2  			rts
*--------------------------------------
*rfcbidx			lda #$01			 	prepare to read index block : read command
*				sta A4L

*				ldx #zpt			 	address of current index buffer.

*				jsr fileio1				go read index block.
*				bcs L400C			 	error

*				ldy fcbptr
*				lda bloknml
*				sta FCBs+FCB.IBLK,y		save block address of this index in fcb
*				lda bloknml+1
*				sta FCBs+FCB.IBLK+1,y

**				clc

*L400C  			rts
*--------------------------------------
wfcbfst			jsr upbmap				update the bitmap and write file's 1st block.

				lda #$02				write command
				.HS 2C					skip next instruction

rfcbfst			lda	#$01				read command.

				pha		 				save the command
				lda #FCB.1stBLK
				ora fcbptr			 	add offset to fcbptr
				tay
				pla

				ldx #zpt			 	rd block into index portion of file buf
*--------------------------------------
dofileio 		sta A4L			  		command

				lda FCBs,y				get disk block address from fcb.
				sta bloknml				block 0 not legal
				bne .1
				
				lda FCBs+1,y			high address of disk block
				bne .2

				lda #$0C			 	Block = $0000, allocation error.
				jsr GP.SysDeath			doesn't return...

.1  			lda FCBs+1,y	
.2				sta bloknml+1
*--------------------------------------
fileio1			lda $00,x			  	get memory address of buffer from
				sta buf			  		page zero pointed to by x register
				lda $01,x
				sta buf+1				and pass address to device handler

				jsr XDOS.FCBDevIDSelect

				lda #$FF			 	also, set to indicate reg call made to
				sta ioaccess			device handler.
				lda devnum			 	transfer device # for dispatcher
				sta unitnum				to convert to unit #.
				stz p8error				clear global error code.
				jmp XDOS.DevCall	 	call the driver.
*--------------------------------------
wfcbdat			ldx #datptr				point at memory address with x and
				lda #FCB.DBLK		 	disk address with y.
				ora fcbptr			 	add offset to fcbptr
				tay		 				and put in y.
				lda #$02			 	write data block.
				jsr dofileio
				bcs L4096			  	if errors.

				lda #$BF			 	mark data status as current.
				bra XDOS.ResetFCBStatus

wfcbidx			jsr upbmap			 	update bitmap.

				ldx #zpt			 	point to address of index buffer
				lda #FCB.IBLK		 	and block address of that index block.
				ora fcbptr
				tay
				lda #$02
				jsr dofileio			go write out index block.
				bcs L4096			  	if errors.

				lda #$7F			 	mark index status as current.
*--------------------------------------
XDOS.ResetFCBStatus
				ldx fcbptr
				and FCBs+FCB.F,x
				sta FCBs+FCB.F,x

L4096  			rts
*--------------------------------------
XDOS.Open		jsr XDOS.FindFileOrVol	look up the file.
				bcs L4096			  	if not, then error.

L40A0  			jsr tstopen				are any other files writing to this
				bcc L40AD			  	same file ? branch if not.

L40A5  			lda #MLI.E.OPEN		 	file is busy, shared access not allowed.
				.HS 2C
L40A9  			lda #MLI.E.UNSUPST		file is wrong storage type.
				.HS 2C
L40AB			lda #MLI.E.FCBFULL	 	fcb full error.
				sec
				rts

L40AD  			lda fcbflg				if this byte <> 0 then free fcb found
				beq L40AB			 	and available for use.

				ldx fcbptr				get address of 1st free fcb found.

L40B9  			ldy #FCB

L40BD  			stz FCBs,x		 		but clean it first.
				inx
				dey
				bne L40BD

				ldy #0
				
				ldx fcbptr
				
L40CB  			lda d_dev,y				move ownership info.
				sta FCBs+FCB.DEVID,x	note: this code depends upon the defined
				inx						order of both the fcb and directory entry buffer.
				iny
				cpy #6					
				bne L40CB

				lda d_stor			 	get storage type and
				jsr XDOS.SetFCBSType
				tax		 				save in x for later comparison

				lda d_attr			 	get file's attributes and use it
				and #$03				as a default access request.
				cpx #$0D			 	if directory, don't allow write enable.
				bne L40EB

				and #$01			 	read enabled bit

L40EB  			sta FCBs+FCB.ACCESS,y
				and #$02			 	check for write enabled request.
				beq L40F7			  	branch for open as read-only

				lda totent			 	otherwise, be sure no one else is
				bne L40A5			  	reading the same file. branch if busy.

L40F7  			cpx #$04			 	is it a tree file type ?
				bcc L40FF			  	yes.

				cpx #$0D			 	is it a directory type ?
				bne L40A9			  	if not, wrong storage type.

L40FF  			ldx #$06				move address of 1st block of file, end

L4101  			sta bloknml+1			of file and current usage count.
				lda fcbptr
				ora ofcbtbl,x			this is done via a translation table
				tay		 				between directory info and fcb.
				lda d_frst,x
				sta FCBs,y
				dex
				bpl L4101				last loop stores hi address of 1st block

				sta bloknml				and this is the low one.
				ldx fcbptr
				lda cntent			 	this was set up by 'tstopen'.
				sta FCBs,x				claim fcb for this file.
				jsr alcbuffr			go allocate buffer in memory tables.
				bcs L4147			  	if errors.

				ldx fcbptr
				jsr XDOS.GetFCBBufX		rtn addr of bufs in data & index ptrs.
				lda flevel			 	mark level at which
				sta FCBs+FCB.FLEVEL,x	file was opened.

				lda FCBs+FCB.STYPE,x	file must be positioned at beginning.
				cmp #$04			 	is it a tree file ?
				bcs L415E			  	no, assume a directory.

				lda #$FF			 	fool the position routine into giving
				sta FCBs+FCB.MARK+2,x	a valid position with preloaded data,

				ldy #$02			 	etc. set desired position to 0.
				lda #$00

L413C  			sta tposll,y
				dey
				bpl L413C

				jsr rdposn			 	let tree position routine do the rest.
				bcc L4163			  	if successful.

L4147  			pha		 				save error code.

				ldx fcbptr			 	free buffer space.
				stz FCBs,x				necessary to release fcb also.
				lda FCBs+FCB.BUFID,x
				beq L4156			  	if no bufnum, ok because never alloc'd.

				jsr relbuffr			go release buffer.

L4156  			pla		 				error code.
				sec
				rts

L415E  			jsr XDOS.ReadFCB.DBLK	read in 1st block of directory file.
				bcs L4147			  	return error after freeing buffer & fcb.

L4163  			ldx vcbptr				index to vcb.
				inc VCBs+VCB.OFCNT,x	add 1 to # of files currently open
				
				ldx fcbptr			 	index to fcb.
				lda FCBs+FCB.ID,x		return ref # to user.
				ldy #$05
				sta (A3L),y
*				clc		 				open is successful
				rts
*--------------------------------------
tstopen			stz cntent				returns the ref # of a free fcb.
				stz totent			 	flag to indicate file already open.
				stz fcbflg			 	flag indicates a free fcb is available.

				lda #$00

L4188  			tay						index to next fcb.
				ldx fcbflg			 	test for free fcb found.
				bne L4191			  	if already found.

				inc cntent

L4191  			lda FCBs,y				is this fcb in use ?
				bne L41A3			  	yes.

				txa		 				if not, should we claim it ?
				bne L41C1			  	branch if free fcb already found.

				sty fcbptr			 	save index to new free fcb.
				lda #$FF			 	set fcb flag to indicate
				sta fcbflg			 	free fcb found.
				bne L41C1			  	branch always to test next fcb.

L41A3  			tya		 				add offset to index to ownership info
				ora #$06
				tay		 				and put it back in y.
				ldx #$06			 	index to directory entry owner info.

L41A9  			lda FCBs,y				all bytes must match to say that it's
				cmp d_dev-1,x			the same file again.
				bne L41C1			  	if not, then next fcb.

				dey		 				index to next lower bytes.
				dex
				bne L41A9				loop to check all owner info.

				inc totent			 	file is already open, now see
				lda FCBs+FCB.ACCESS,y	if it's already opened for write.				and #$02			 if so report file busy (with carry set).
				and #$02			 	if so report file busy (with carry set).
				beq L41C1				branch if this file is read access only.

				sec
				rts

L41C1  			tya						calc position of next fcb.
				and #$E0			 	first strip any possible index offsets.
				clc
				adc #FCB			 	inc to next fcb.
				bcc L4188			  	branch if more to compare.

				clc		 				report no conflicts.
				rts
*--------------------------------------
MAN
SAVE usr/src/prodos.fx/prodos.s.xdos.c
LOAD usr/src/prodos.fx/prodos.s
ASM