NEW
  AUTO 3,1
*--------------------------------------
FCB.MAX			.EQ 8
FCB.ID				.EQ 0
FCB.DEVID			.EQ 1				XDOS.DE.DevID -> XDOS.DE.DevID+5
FCB.DIRHBLK			.EQ 2				2 bytes
FCB.DIREBLK			.EQ 4				2 bytes
FCB.DIRENUM			.EQ 6
FCB.STYPE			.EQ 7
FCB.F				.EQ 8
FCB.F.STMOD				.EQ %00001000
FCB.F.UMOD				.EQ %00010000
FCB.F.DBLKMOD			.EQ %01000000
FCB.F.IBLKMOD			.EQ %10000000
FCB.ACCESS			.EQ 9
FCB.NLBYTE			.EQ 10
FCB.BUFID			.EQ 11
FCB.1stBLK			.EQ 12				2 bytes
FCB.IBLK			.EQ 14				2 bytes
FCB.DBLK			.EQ 16				2 bytes
FCB.MARK			.EQ 18				3 bytes
FCB.EOF				.EQ 21				3 bytes
FCB.UBLK			.EQ 24				2 bytes

FCB.FLEVEL			.EQ 27
FCB.DIRTY			.EQ 28


FCB.NLMASK			.EQ 31
*
FCB				.EQ 32
*--------------------------------------
VCB.DEV				.EQ 16
VCB.OFCNT			.EQ 17
VCB.BMAP			.EQ 18				2 bytes
VCB.TBLK			.EQ 20				2 bytes
VCB.FBLK			.EQ 22				2 bytes
VCB.BMAPIDX			.EQ 24
*
VCB				.EQ 25
*--------------------------------------
XDOS.VCBPtr		.EQ XDOS.VCBs+0
XDOS.VCBDupFlag	.EQ XDOS.VCBs+1
XDOS.VCBDupEnt 	.EQ XDOS.VCBs+2
bmcnt			.EQ XDOS.VCBs+3
bmptr			.EQ XDOS.VCBs+4
basval			.EQ XDOS.VCBs+5
XDOS.VCB0		.EQ XDOS.VCBs+6			range $D906-$DA00
*--------------------------------------
* ZERO Page
*--------------------------------------
zpt				.EQ	$48					highly used zero page index pointer
ZP.DataPtr		.EQ	$4A					ptr to data area of buffer.
sos				.EQ	$4C					sos buffer pointer.
ZP.UserBuf		.EQ	$4E					data ptr in user buffer.
*--------------------------------------
XDOS.START		.PH XDOS

				.DO AUXLC=0

XDOS.MAIN		cld						no decimal.

				sty GP.MLIY				save x and y
				stx GP.MLIX

				ply						get processor status

				pla						find out the address of the caller
				sta ZP.A3L
				clc						preserve the address of the call spec.
				adc #$04
				sta GP.MLIRTN			last MLI call return address
				pla
				sta ZP.A3L+1
				adc #$00
				sta GP.MLIRTN+1

				phy						pull processor status
				
				.ELSE
				
XDOS.AUX		cld
				
				bit IO.RRAMWRAMBNK1
				sty GP.BNKBYT2

				stx GP.MLIEXIT.X+1

				tsx
				stx $100
				ldx	$101
				txs

				sec
				ror GP.MLIACTV

				pha

				lda GP.MLIEXIT.PCL+1
				sta ZP.A3L
				clc
				adc #$04
				sta GP.MLIEXIT.PCL+1
				lda GP.MLIEXIT.PCH+1
				sta ZP.A3L+1
				adc #$00
				sta GP.MLIEXIT.PCH+1
				
				.FIN
*--------------------------------------
				plp						to re-enable interrupts.
				cld						still no decimal
				stz	GP.ERROR			clear any previous errors.
				ldy #$01				find out if command is valid.
				lda	(ZP.A3L),y			get command #

				lsr						and hash it to a range of 0-$1F
				lsr
				lsr
				lsr
				clc
				adc (ZP.A3L),y
				and #$1F
				tax
				lda (ZP.A3L),y			check result to see if valid command #
				cmp XDOS.CmdNums,x
				bne XDOS.BadCall

				iny						index to call spec parm list.
				lda (ZP.A3L),y			make A3L point to parameter count byte
				pha						in parameter block.
				iny
				lda (ZP.A3L),y
				sta ZP.A3L+1
				pla
				sta ZP.A3L

				lda	XDOS.ParamCnt,x		make sure parameter list has the correct # of parameters.
				beq .2					clock has 0 parameters.

				cmp (ZP.A3L)
				bne XDOS.BadCnt			error if wrong count.

				lda XDOS.CmdNums,x		get call # again
				cmp #MLI.QUIT			is it quit?
				beq .1					if so, then call quit dispatcher

				asl					 	carry set if BFMgr or DevMgr
				bpl .3
				bcs .4

				lsr						shift back down for interrupt manager
				and #$03				valid calls are 0 and 1
				jsr XDOS.IntMgr
				bra XDOS.Exit

.1				jmp GP.DISPATCH			P8 system death vector

.2				jsr GP.CLOCK		 	go read clock.
				bra XDOS.Exit			no errors possible

.3		 		lsr						shift back down for device manager.
				adc #$01				valid commands are 1 and 2.
				sta ZP.CMDNUM
				jsr XDOS.DevMgr			execute read or write request.
				bra XDOS.Exit

.4				lsr						shift back down for block file manager.
				and #$1F				valid commands are 0-$13
				tax

				jsr XDOS.BFMgr
*--------------------------------------
XDOS.Exit		stz GP.BUBIT			clear backup bit

				ldy GP.ERROR			P8 error code
				cpy #$01				if > 0 then set C
				tya						and set Z
				php						disable interrupts until exit complete.
				sei
				lsr GP.MLIACTV			indicate MLI done.

				ply						Get status register until return.

* Y = Status register
* A = MLI Error code
				
				.DO AUXLC=0

				ldx GP.MLIRTN+1			place last MLI call return address
				phx						on stack. return is done via 'rti'
				ldx GP.MLIRTN			so the status register is restored
				phx						at the same time, so

				phy						place status back on stack

				pha						Push return error, if any.

				ldx GP.MLIX				MLI X register savearea
				ldy GP.MLIY				MLI Y register savearea
				lda GP.BNKBYT1			restore language card status
				jmp GP.MLIEXIT			and return.
				
				.ELSE
				
				tsx
				stx $101
				ldx	$100
				txs
				jmp GP.MLIEXITX
				
				.FIN
*--------------------------------------
XDOS.NoDevice 	lda #MLI.E.NODEV		no device connected.
				jsr GP.SYSERR

XDOS.BadCall	lda #MLI.E.BADCALL
				.HS 2C					BIT ABS
XDOS.BadCnt		lda #MLI.E.BADCNT
				jsr XDOS.GoSysErr
				bra XDOS.Exit
*--------------------------------------
* ProDOS Device Manager
*--------------------------------------
XDOS.DevMgr		ldy #$05				the call spec for devices must

.1	  			lda (ZP.A3L),y			be passed to drivers in page zero:
				sta ZP.CMDNUM,y
				dey
				bne .1

				ldx ZP.BUFPTR+1			buffer page
				stx ZP.UserBuf+1			to user buffer
				inx
				inx
				lda ZP.BUFPTR			is buffer page aligned (nn00) ?
				beq .2					branch if it is

				inx						else account for 3-page straddle

.2  			jsr vldbuf1				make sure user buffer is not
				bcs XDOS.GoSysErr		conflicting with protected ram.

				jsr XDOS.DevCall		call internal entry for device dispatch
				bcc XDOS.DevCall.RTS

XDOS.GoSysErr	jsr GP.SYSERR
*--------------------------------------
XDOS.DevCall	php						do not allow interrupts.
				sei

				lda ZP.UNITNUM			get device # and
				and #$F0				strip misc lower nibble
				sta ZP.UNITNUM			then save it.
				lsr						use as index to device table
				lsr
				lsr
				tax
				jsr XDOS.DevCall.Jmp
				bit IO.CLRC8ROM			RELEASE $C800-$CFFF ROM space
				bcs .9

				plp
				clc
				rts

.9				plp
				sec

XDOS.DevCall.RTS
				rts

XDOS.DevCall.Jmp
				jmp (GP.DEVPTRS,x)		goto driver (or error if no driver)
*--------------------------------------
* ProDOS interrupt manager
*--------------------------------------
XDOS.IntMgr		sta ZP.A4L				interrupt command
				lsr						allocate interrupt or deallocate?
				bcs .4					branch if deallocate.

				ldx #$03				test for a free interrupt space in tbl.

.1				lda	GP.IRQVs-2,x		test high address for 0.
				bne	.2					branch if spot occupied.

				ldy	#$03				get address of routine.
				lda	(ZP.A3L),y			must not be zero page.
				beq .3					error if it is.

				sta GP.IRQVs-2,x		save high address
				dey
				lda (ZP.A3L),y
				sta GP.IRQVs-3,x		and low address.
				txa						return interrupt # in range 1-4
				lsr
				dey
				sta (ZP.A3L),y			pass back to user.
				clc						no errors.
				rts

.2  			inx
				inx						next lower priority spot
				cpx #$0B				are all 4 already allocated?
				bne	.1					branch if not.

				lda	#MLI.E.IRQFULL		interrupt table full
				.HS 2C					BIT ABS
.3				lda #MLI.E.INVPARAM		invalid parameter.
				jsr GP.SYSERR

.4				ldy #$01			   	zero out interrupt vector
				lda	(ZP.A3L),y			but make sure it is a valid #.
				beq .3					error if < 1

				cmp #$05				or > 4
				bcs .3

				asl
				tax

				stz GP.IRQVs-2,x
				stz GP.IRQVs-1,x
*				clc
				rts
*--------------------------------------
XDOS.SysErr		sta GP.ERROR			P8 error code
				plx
				plx						pop 1 level of return
				sec
				rts
*--------------------------------------
* $01 = more than 255 unclaimed irqs
* $0A = open file has no volume
* $0B = open file has no 1K buffer
* $0C = block allocation error.
*--------------------------------------
XDOS.SysDeath 	tax						death error code.
				sta IO.CLR80DISP		disable 80 col hardware.
				sta IO.SETTEXT			switch in text.
				lda XDOS.CortFlag		is this a Cortland?
				beq .1					if not, don't use super hires switch.

				stz IO.GS.NEWVIDEO		force off super hires.

.1	  			sta IO.CLRPAGE2			switch in text page 1.

				ldy #XDOS.SysErrMsgL-1

.2  			lda XDOS.SysErrMsg,y
				sta $400,y				'SYS ERR-$'
				dey
				bpl .2

				txa						x = death error code
				and #$0F				convert to ascii
				ora #$30
				cmp #$3A
				bcc .3					branch if not > 9.

				adc #$06				inc to alpha a-f

.3  			ldy #XDOS.SysErrMsgL
				ora #$80
				sta $400,y

				lda #" "

.4				iny
				sta $400,y
				cpy #39
				bne .4

				bra *
*--------------------------------------
* ProDOS Block File Manager
*--------------------------------------
XDOS.BFMgr		lda XDOS.CmdFlags,x		translate into command address.
				asl						bit 7 indicates pathname to process
				sta cmdtemp
				and #$3F				bit 6  is refnum, 5 is time to process
				tax
				lda XDOS.CmdJmps,x		move address to indirect jump
				sta .8+1
				lda XDOS.CmdJmps+1,x	high byte
				sta .8+2

				lda #$20				init backup bit flag
				sta bkbitflg			to say 'file modified'
				bcc .1

				jsr XDOS.GetPath		process pathname before calling command
				bcs .9					branch if bad name.

.1				asl cmdtemp				test for refnum processing
				bcc .2

				jsr XDOS.GetFCB			set pointers to fcb and vcb of file
				bcs .9

.2		 		asl cmdtemp				check for necessity of time stamp
				bcc .8

				jsr GP.CLOCK			date/time

.8  			jsr $FFFF				SELF MODIFIED : execute command
				bcc .10

.9		 		jsr GP.SYSERR

.10				rts
*--------------------------------------
* entry used by rename for 2nd pathname.
*--------------------------------------
XDOS.GetRenPath	ldy #$03			 	get address to new pathname
				.HS 2C
*--------------------------------------
XDOS.GetPath	ldy #$01				index to pathname pointer
				lda (ZP.A3L),y			low pointer address
				sta zpt

				iny
				lda (ZP.A3L),y			hi pointer address
				sta zpt+1

				ldx #$00				x = index to XDOS.PathBuf
				ldy #$00				y = index to input pathname.

				stz prfxflg				assume prefix is in use.
				stz XDOS.PathBuf		mark XDOS.PathBuf = nothing processed.

				lda (zpt),y				validate pathname length > 0 and < 65
				beq .5

				cmp #$41
				bcs .5

				sta pathcnt				this is used to compare for
				inc pathcnt				end of pathname processing.

				iny						now check for full pathname...
				lda (zpt),y				(full name if starts with '/')
				and #$7F
				cmp #'/'
				bne .1					branch if prefix appended.

				dec prfxflg				set prefix flag = prefix not used.
				iny						index to 1st character of pathname.

.1  			lda #$FF				set current position of XDOS.PathBuf
				sta XDOS.PathBuf,x		to indicate end of pathname.

				sta namcnt				$FF = no chars processed in local name.
				stx namptr				pointer to local name length byte.

.2  			cpy pathcnt				done with pathname processing?
				bcs .6

				lda (zpt),y				get character
				and #$7F
				inx						prepare for next char
				iny
				cmp #'/'				is it delimiter '/' ?
				beq .8					yes

				.DO LOWERCASE=0
				cmp #'a'				lowercase?
				bcc .3					no

				cmp #'z'+1
				bcs .3
				
				eor #$20				to uppercase
.3				.FIN

				sta XDOS.PathBuf,x		store char
				inc namcnt				is it the 1st char of a local name?
				bne .4					no

				inc namcnt				increment to 1
				jsr XDOS.IsValidFirstChar
				bcc .2

				bra errsyn

.4				jsr XDOS.IsValidChar
				bcc .2

.5				bra errsyn

.6				lda #$00			 	end pathname with a 0
				bit namcnt				also make sure count is positive
				bpl .7

				sta namcnt
				dex

.7  			inx
				sta XDOS.PathBuf,x
				beq errsyn					error if '/' only.

				stx pathcnt				save length of pathname
				tax

.8		  		lda namcnt				validate local name < 16
				cmp #16
				bcs errsyn

				phx						save pointer
				ldx namptr				get index to beginning of local name
				sta XDOS.PathBuf,x			save local name's length
				plx						restore pointer
				bne .1					branch if more names to process

				clc						probably no error, but
				lda prfxflg				make sure all pathnames are prefixed
				bne .9					or begin with a '/'.

				lda GP.NEWPFXPTR		must be non-zero
				beq errsyn

.9  			rts
*--------------------------------------
errsyn			lda #MLI.E.INVPATH
				.HS 2C					BIT ABS
ptyperr			lda #MLI.E.UNSUPST		filetype error (not a directory)
pfxerr			sec
pfx.RTS			rts
*--------------------------------------
XDOS.SetPrefix	jsr XDOS.GetPath		call is made to detect if a null path.
				bcc .1					path ok.

				ldy XDOS.PathBuf		is it a null pathname?
				bne pfxerr				error if not

				sty GP.NEWPFXPTR		fix appletalk PFI bug
				sty GP.PFXPTR
				clc						no error
				rts

.1  			jsr XDOS.FindFileOrVol	go find specified prefix directory.
				bcs pfx.RTS				branch if error is not root directory.

				lda XDOS.DE.Filename	make sure last local name is dir type
				and #$D0				(either root or sub).
				eor #$D0				directory?
				bne ptyperr				wrong type

				ldy prfxflg				new or appended prefix?
				bne .2

				lda GP.NEWPFXPTR		append new prefix to old

.2  			tay
				sec						find new beginning of prefix
				sbc pathcnt
				cmp #$C0				too long?
				bcc errsyn				then error

				tax
				sta GP.NEWPFXPTR
				sta GP.PFXPTR

*				lda XDOS.DE.DevID				save device #
*				sta p_dev
				lda XDOS.DE.KeyPtr				and address of 1st block
				sta p_blok
				lda XDOS.DE.KeyPtr+1
				sta p_blok+1

.3				lda XDOS.PathBuf,y
				sta XDOS.PathBuf,x
				iny
				inx
				bne .3

				clc						good prefix
				rts
*--------------------------------------
XDOS.GetPrefix	ldy #$01				get index to users pathname buffer
				lda (ZP.A3L),y
				sta ZP.UserBuf				user buffer ptr
				iny
				lda (ZP.A3L),y
				sta ZP.UserBuf+1

*				clc						calc how big a buffer is needed.
				
				stz cbytes+1			set buffer length at 64 char max
				lda #$40
				sta cbytes

				jsr valdbuf				go validate prefix buffer address
				bcs pfx.RTS

				ldy #$00				y = indirect index to user buffer.
				lda GP.NEWPFXPTR		get address of beginning of prefix
				tax
				beq .1					if null prefix.

				eor #$FF				get total length of prefix
				adc #$02				add 2 for leading and trailing slashes.

.1		  		sta (ZP.UserBuf),y			store length in user's buffer.
				beq .8					branch if null prefix.

.2		 		iny						inc to next user buffer location.
				lda XDOS.PathBuf,x		get next char of prefix.

.3		 		sta (ZP.UserBuf),y		  	give char to user.
				and #$F0				check for length descriptor.
				bne .4					branch if regular character

				lda #'/'				otherwise, substitute a slash.
				bne .3					branch always

.4  			inx
				bne .2					branch if more to send.

				iny
				lda #'/'				end with '/'
				sta (ZP.UserBuf),y

.8		  		clc						no error
				rts
*--------------------------------------
XDOS.GetFCB		ldy #$01				index to ref#
				lda (ZP.A3L),y			is it a valid file# ?
				beq badref				must not be 0.

				cmp #FCB.MAX+1
				bcs badref

				pha
				dec
				lsr
				ror
				ror
				ror						multiply by 32.
				sta XDOS.FCBPtr				used as an index to fcb
				tax
				pla						restore ref# in acc
				cmp XDOS.FCBs+FCB.ID,x
				bne errnoref
*--------------------------------------
XDOS.GetFCBBufX	lda XDOS.FCBs+FCB.BUFID,x	get page address of file buffer.

				tay						index into global buffer table.
				lda GP.BUFTABL-1,y
				sta XDOS.BufAddr+1
				beq .3					fcb corrupted

				sta ZP.DataPtr+1		save ptr to data area of buffer
				inc
				inc						index block always 2 pages after data
				sta zpt+1

				lda GP.BUFTABL-2,y		???? ALWAYS 0
				sta XDOS.BufAddr
				sta ZP.DataPtr			index and data buffers always on
				sta zpt					page boundaries.

				jsr XDOS.FCBDevIDSelect

				lda #XDOS.VCB0

.1				tay						search for associated vcb
				lda XDOS.VCBs+VCB.DEV,y
				cmp XDOS.FCBs+FCB.DEVID,x	is this vcb the same device?
				beq .4					if it is, make sure volume is active.

.2				tya					 	adjust index to next vcb.
				clc
				adc #VCB
				bcc .1					loop until volume found.

				lda #$0A				open file has no volume so
				.HS 2C					BIT ABS

.3				lda #$0B				fcb error so

				jsr GP.SYSDEATH			kill the system.

.4		 		lda XDOS.VCBs,y			make sure this vcb is open.
				beq .2					branch if it is not active.

				sty XDOS.VCBPtr			save ptr to good vcb.
				clc						no error
				rts						Y = XDOS.VCBPtr, X = XDOS.FCBPtr
*--------------------------------------
errnoref 		stz XDOS.FCBs,x

badref 			lda #MLI.E.BADREF		requested refnum is
				sec						illegal (out of range)
				rts
*--------------------------------------
XDOS.Online		jsr XDOS.GetUserBuf		figure out how big buffer has to be.

				stz cbytes				set this for valdbuf routine.
				stz cbytes+1

				ldy #$01
				lda (ZP.A3L),y				if 0 then cbytes=$100 else $010 for one
				and #$F0				device. mask out unused nibble.
				sta GP.DEVNUM				last device used.
				beq .1					branch if all devices.

				lda #$10				cbytes = $010
				sta cbytes
				bne .2					always taken

.1  			inc cbytes+1			cbytes = $100

.2  			jsr valdbuf				go validate buffer range against
				bcs .9					allocated memory.

				lda #$00				zero out user buffer space
				ldy cbytes

.3	  			dey
				sta (ZP.UserBuf),y
				bne .3

				sta namptr				used as pointer to user buffer.
				lda GP.DEVNUM			get device # again.
				bne online1				branch if only 1 device to process.

				ldx GP.DEVCNT

.4  			phx						save index to last item on list
				lda GP.DEVLST,x		   	active device list.
				and #$F0			 	strip device type info.
				sta GP.DEVNUM			save desired device to look at.
				jsr online1				log this volume and return it's name.
				lda namptr				inc pointer for next device
				clc
				adc #$10
				sta namptr
				plx						get index to device list.
				dex						next device.
				bpl .4					branch if there is another device.

				lda #$00				no errors for multiple on-line
				clc
.9		 		rts
*--------------------------------------
online1			jsr XDOS.FindVCBForDevNum	see if it has already been logged in.
				bcs online1.ERR			branch if vcb is full.

				lda #$02
				ldx #$00				read in root (volume) directory
				jsr XDOS.ReadGBufAX		read ROOT VOL into general purpose buffer.
				bcc .1					branch if read was ok.

				ldx XDOS.VCBPtr
				ldy XDOS.VCBs+VCB.OFCNT,x	don't take the vcb offline if
				bne online1.ERR			there are active files present.

				stz XDOS.VCBs,x				now take the volume offline
				stz XDOS.VCBs+VCB.DEV,x

				bra online1.ERR			branch if unable to read.

.1		 		.DO LOWERCASE=1
				jsr XDOS.CheckAndUnpackGBuf
				bcs online1.ERR
				.FIN

				ldx XDOS.VCBPtr
				lda XDOS.VCBs,x				has it been logged in before?
				beq .2					if not.

				lda XDOS.VCBs+VCB.OFCNT,x	it has, are there active files?
				bne .3					branch if volume is currently busy.

.2  			jsr XDOS.VCBMountAtX
				bcs online1.ERR			branch if there is a problem.

				lda #MLI.E.DUPVOL		anticipate a duplicate active volume
				bit XDOS.VCBDupFlag		exits.
				bmi online1.ERR			branch if so.

.3  			ldx XDOS.VCBPtr
				jsr XDOS.VCBCmpGBUF		does vol read compare with logged vol?
				lda #MLI.E.DSKSWIT		anticipate wrong volume mounted.
				bcc online1.OK			branch if ok.
*--------------------------------------
online1.ERR		pha						save error code.
				jsr svdevn				report what device has problem.
				pla						error code.
				iny						tell what error was encountered.
				sta (ZP.UserBuf),y
				cmp #MLI.E.DUPVOL		duplicate volume error?
				bne .1					no.

				iny						report which other device has same name
				ldx XDOS.VCBDupEnt
				lda XDOS.VCBs+VCB.DEV,x
				sta (ZP.UserBuf),y
				stz XDOS.VCBDupFlag		clear duplicate flag.

				lda #MLI.E.DUPVOL		duplicate volume error code.

.1  			sec						flag error
				rts
*--------------------------------------
online1.OK		lda XDOS.VCBs,x			get volume name count
				sta namcnt
				ldy namptr				index to user's buffer.

.1  			lda XDOS.VCBs,x			move name to user's buffer
				sta (ZP.UserBuf),y
				inx
				iny
				dec namcnt
				bpl .1
*--------------------------------------
svdevn			ldy namptr				index to 1st byte of this entry.
				lda GP.DEVNUM			upper nibble = device# and
				ora (ZP.UserBuf),y			lower nibble = name length.
				sta (ZP.UserBuf),y

				clc						no errors
				rts						end of block file manager
*--------------------------------------
XDOS.Create		jsr XDOS.CheckPath		check for duplicate, get free entry
				bcc	.4					error code may be 'file not found'

				cmp #MLI.E.FNOTFND		'file not found' is ok
				bne .5					otherwise exit with error.

				ldy #$07				test for tree or directory file,
				lda (ZP.A3L),y			no other kinds are legal.
				cmp #$04				is it seed, sapling or tree?
				bcc .1					branch if it is

				cmp #$0D
				bne .3					report type error if not directory.

.1				lda GP.DEVNUM			make sure destination device
				jsr XDOS.TestWPA		is not write protected.
				bcs H351D

				lda nofree				is there space in directory to

				.DO DIREXTENDROOT=1

				beq XDOS.DirExtend
				bne XDOS.Create1
				
				.ELSE
				
				beq .2					add this file? branch if not

				jmp XDOS.Create1		otherwise, go create file.

.2				lda XDOS.OH.Blk				before extending directory,
				ora XDOS.OH.Blk+1			make sure it's a subdirectory.
				bne XDOS.DirExtend

				lda #MLI.E.DIRFULL		otherwise, directory full error
				.HS 2C					BIT ABS

				.FIN

.3				lda #MLI.E.UNSUPST		filetype error
				.HS 2C					BIT ABS
.4				lda #MLI.E.DUPFILE		name already exists

.5				sec
H351D  			rts
*--------------------------------------
XDOS.DirExtend	lda ZP.BLKNUM			preserve disk address of current (last)
				pha						directory link, before allocating an
				lda ZP.BLKNUM+1			extended block.
				pha
				jsr XDOS.GetFreeBlk		allocate a block for extending directory
				plx
				stx ZP.BLKNUM+1			restore block addr of dir info in XDOS.GBuf
				plx
				stx ZP.BLKNUM
				bcs H351D				unable to allocate.
			
				sta XDOS.GBuf+2			save block address in y,a to
				sty XDOS.GBuf+3			current directory.
				.DO LOWERCASE=1
				jsr XDOS.WriteGBufDir
				.ELSE
				jsr XDOS.WriteGBuf		update directory block with new link.
				.FIN
				bcs H351D				if error

				ldx #$01

.1		 		lda ZP.BLKNUM,x			prepare new directory block
				sta XDOS.GBuf,x			using current block as back link
				lda XDOS.GBuf+2,x
				sta ZP.BLKNUM,x			and save new block as next to be written
				dex
				bpl .1

				jsr XDOS.ZeroGBuf

				jsr XDOS.WriteGBuf		write prepared directory extension.
				bcs H351D				if error

				lda XDOS.OH.Blk
				ldx XDOS.OH.Blk+1

				.DO LOWERCASE=1
				jsr XDOS.ReadGBufAXDir
				.ELSE
				jsr XDOS.ReadGBufAX		read in parent directory block
				.FIN

				jsr XDOS.ZPT.InitGBuf

				ldx XDOS.OH.EIB			and calc entry address.

.3  			dex						has entry address been calculated?
				beq .4					if yes.

				lda XDOS.OH.EL				next entry address
				jsr XDOS.ZPT.NextA
				bra .3

.4  			ldy #$13				index to block count
				clc

.5  			lda (zpt),y
				adc dinctbl-$13,y		add 1 to block count and
				sta (zpt),y
				iny
				tya						$200 to the directory's eof.
				eor #$18				done with usage/eof update?
				bne .5					branch if not.

				.DO LOWERCASE=1
				jsr XDOS.WriteGBufDir
				.ELSE
				jsr XDOS.WriteGBuf		go update parent.
				.FIN
				bcs crerr2

				jmp XDOS.Create

crerr2 			rts						return and report errors
*--------------------------------------
XDOS.Create1	jsr XDOS.ZeroGBuf		zero out XDOS.GBuf

				ldy #$0B				move user specified date/time

.1				lda (ZP.A3L),y			to directory.
				sta XDOS.DE.Type,y
				txa		 				if all 4 bytes of date/time = 0
				ora (ZP.A3L),y			then use built-in date/time.
				tax
				dey
				cpy #$07
				bne .1

				txa						does user want default time?
				bne .3					if not.

				ldx #$03

.2		 		lda GP.DATE,x			move current default date/time
				sta XDOS.DE.CTime,x
				dex
				bpl .2

.3				lda (ZP.A3L),y			y = index to file kind.
				cmp #$04
				lda #$10				assume tree type
				bcc .4

				lda #$D0			 	it's directory.

.4		 		ldx namptr			 	index to local name of pathname.
				ora XDOS.PathBuf,x		combine file kind with name length.
				sta XDOS.DE.Filename	sos calls this 'storage type'.
				and #$0F			 	strip back to name length
				tay		 				and use as counter for move.
				clc
				adc namptr			 	calc end of name
				tax

.5				lda XDOS.PathBuf,x		move local name as filename
				sta XDOS.DE.Filename,y

				dex
				dey
				bne .5

				ldy #$03				index to ACCESS parameter
				lda (ZP.A3L),y
				sta XDOS.DE.Access
				iny						also move TYPE
				lda (ZP.A3L),y
				sta XDOS.DE.Type

.6		 		iny						move AUXTYPE
				lda (ZP.A3L),y
				sta XDOS.DE.AuxType-5,y
				cpy #$06
				bne .6

				.DO LOWERCASE=0
				lda xdosver				save current xdos version #
				sta XDOS.DE.Version

				lda compat			 	and backward compatibility #
				sta XDOS.DE.MVersion
				.FIN

				lda #$01			 	usage is always 1 block
				sta XDOS.DE.BlkUsed

				lda XDOS.DE.DirHBlk		place back pointer to header block
				sta XDOS.DE.BlkPtr
				lda XDOS.DE.DirHBlk+1
				sta XDOS.DE.BlkPtr+1

				lda XDOS.DE.Filename	storage type.
				and #$E0			 	is it a directory?
				beq XDOS.CreateDBLK		branch if seed file.
*--------------------------------------
* Create Dir First Block
*--------------------------------------
XDOS.Create2	ldx #$1E			 	move header to data block

.1		 		lda XDOS.DE.Filename,x
				sta XDOS.GBuf+4,x
				dex
				bpl .1

				eor #$30
				sta XDOS.GBuf+4			make it a directory header mark.

				.DO LOWERCASE=0

				ldx #$07			 	overwrite password area and other

.2				lda pass,x				header info.
				sta XDOS.GBuf+20,x

				lda xdosver,x
				sta XDOS.GBuf+32,x
				dex
				bpl .2

				.ELSE

				ldx #XDOS.VolHdrDef.Cnt-1

.2				lda XDOS.VolHdrDef,x
				sta XDOS.GBuf+34,x
				dex
				bpl .2

				lda #$75
				sta XDOS.GBuf+20

				ldx #7
				
.3				stz XDOS.GBuf+20,x
				dex
				bne .3

				.FIN

				ldx #$02				and include info about parent directory
				stx XDOS.DE.EOF+1		set file size = 512

.4		 		lda XDOS.DE.DirEBlk,x
				sta XDOS.GBuf+39,x
				dex
				bpl .4

				lda XDOS.DH.EL			lastly, the length of parent's
				sta XDOS.GBuf+42		directory entries.

				.DO LOWERCASE=1
				jsr XDOS.PackGBuf
				.FIN
*--------------------------------------
XDOS.CreateDBLK	jsr XDOS.GetFreeBlk		get address of file's data block
				bcs crerr3

				sta XDOS.DE.KeyPtr
				sty XDOS.DE.KeyPtr+1
				sta ZP.BLKNUM
				sty ZP.BLKNUM+1
				jsr XDOS.WriteGBuf		go write data block of file
				bcs crerr3

				inc XDOS.DH.FileCnt		add 1 to total # of files in this dir
				bne .1

				inc XDOS.DH.FileCnt+1

.1				jsr XDOS.DE.Update		go revise directories with new file
				bcs crerr3

				jmp XDOS.FlushBM	 	lastly, update volume bitmap
*--------------------------------------
XDOS.ZeroGBuf	ldx #0

.1				stz XDOS.GBuf,x
				stz XDOS.GBuf+$100,x
				inx
				bne .1
				
				rts
*--------------------------------------
MAN
SAVE usr/src/prodos.fx/prodos.s.xdos.a
LOAD usr/src/prodos.fx/prodos.s
ASM