NEW
  AUTO 3,1
* object code = mli_2
* xdos mli system call processor
				.OP 65C02
ofsX			.EQ	*-xdosorg		offset to xdos org

xdosmli			.EQ	*-ofsX				xdos MLI in aux ram
xdosobj			cld							no decimal.
				pla	get processor status
				sta spare1				save it temporarily
				sty mliy				save x and y
				stx mlix			 
				pla	find out the address of the caller
				sta A3L
				clc	preserve the address of the call spec.
				adc #$04
				sta mliretn				last MLI call return address
				pla
				sta A3L+1
				adc #$00
				sta mliretn+1
				lda spare1
				pha	pull processor status
				plp	to re-enable interrupts.
				cld	still no decimal
				ldy #$00
				sty	p8error				clear any previous errors.
				iny						find out if command is valid.
				lda	(A3L),y				get command #
				lsr					and hash it to a range of 0-$1F
				lsr
				lsr
				lsr
				clc
				adc (A3L),y
				and #$1F
				tax
				lda (A3L),y				check result to see if valid command #
				cmp scnums,x
				bne scnerr
				iny	index to call spec parm list.
				lda (A3L),y				make A3L point to parameter count byte
				pha	in parameter block.
				iny
				lda (A3L),y
				sta A3L+1
				pla
				sta A3L
				ldy #$00				make sure parameter list has the
				lda	pcntbl,x			correct # of parameters.
				beq goclock				clock has 0 parameters.
				cmp (A3L),y
				bne scperr				error if wrong count.
				lda scnums,x			get call # again
				cmp #$65				is it quit?
				beq special				if so, then call quit dispatcher
				asl					 carry set if bfm or dev mgr
				bpl godevmgr
				bcs gobfmgr
				lsr					shift back down for interrupt manager
				and #$03				valid calls are 0 and 1
				jsr intmgr
				bra exitmli
special			jmp jspare				P8 system death vector
goclock			jsr clockv			 	go read clock.
				bra exitmli				no errors possible
godevmgr 		lsr					shift back down for device manager.
				adc #$01				valid commands are 1 and 2.
				sta A4L					save command #.
				jsr devmgr				execute read or write request.
				bra exitmli
gobfmgr			lsr					shift back down for block file manager.
				and #$1F				valid commands are 0-$13
				tax
				jsr bfmgr
exitmli			stz bubit				clear backup bit
				ldy p8error				P8 error code
				cpy #$01				if > 0 then set carry
				tya	and set z flag.
				php	disable interrupts until exit complete.
				sei
				lsr mliact				indicate MLI done.
				plx	save status register until return.
				lda mliretn+1			place last MLI call return address
				pha	on stack. return is done via 'rti'
				lda mliretn				so the status register is restored
				pha	at the same time, so
				phx	place status back on stack
				tya	return error, if any.
				ldx mlix				MLI X register savearea
				ldy mliy				MLI Y register savearea
				pha
				lda bnkbyt1				restore language card status
				jmp HBFA0				and return.
nodevice 		.EQ	*-ofsX
				lda #$28				no device connected.
				jsr p8errv				P8 error vector.
scnerr			lda #$01				no such command.
				bne H30B0
scperr			lda #$04				parameter count is invalid
H30B0  			jsr gosyserr
				bcs exitmli				always taken

* ProDOS Device Manager

devmgr			.EQ	*-ofsX	
				ldy #$05
				php						do not allow interrupts.
				sei						the call spec for devices must
H30B9  			lda (A3L),y				be passed to drivers in page zero:
				sta	(A4L),y				sta $0042,y
				dey
				bne H30B9
				ldx buf+1				buffer page
				stx usrbuf+1			to user buffer
				inx
				inx
				lda buf					is buffer page aligned (nn00) ?
				beq H30CC				branch if it is
				inx						else account for 3-page straddle
H30CC  			jsr vldbuf1				make sure user buffer is not
				bcs dvmgrerr			conflicting with protected ram.
				jsr dmgr				call internal entry for device dispatch
				bcs dvmgrerr			branch if error
				plp
				clc	no error
				rts
dvmgrerr 		plp	restore interrupt status
gosyserr 		.EQ	*-ofsX
				jsr p8errv				P8 error vector
dmgr			.EQ	*-ofsX				interrupts must always be off.
				lda unitnum				get device # and
				and #$F0				strip misc lower nibble
				sta unitnum				then save it.
				lsr					use as index to device table
				lsr
				lsr
				tax
				lda drivertbl1,x		fetch driver address
				sta goadr
				lda drivertbl1+1,x
				sta goadr+1
gocmd			.EQ	*-ofsX
				jmp (goadr)				goto driver (or error if no driver)

* ProDOS interrupt manager

intmgr			.EQ	*-ofsX
				sta A4L					interrupt command
				lsr					allocate interrupt or deallocate?
				bcs dealcint			branch if deallocate.
				ldx #$03				test for a free interrupt space in tbl.
alcint	lda	inttbl-2,x					test high address for 0.
				bne	H3118				branch if spot occupied.
				ldy	#$03				get address of routine.
				lda	(A3L),y				must not be zero page.
				beq badint				error if it is.
				sta inttbl-2,x			save high address
				dey
				lda (A3L),y
				sta inttbl-3,x			and low address.
				txa	return interrupt # in range 1-4
				lsr
				dey
				sta (A3L),y				pass back to user.
				clc	no errors.
				rts
H3118  inx
				inx	next lower priority spot
				cpx #$0B				are all 4 already allocated?
				bne	alcint				branch if not.
				lda	#$25				interrupt table full
				bne	H3124
badint			lda #$53				invalid parameter.
H3124  			jsr p8errv				P8 error vector.
dealcint		ldy #$01			   	zero out interrupt vector
				lda	(A3L),y				but make sure it is a valid #.
				beq badint				error if < 1
				cmp #$05				or > 4
				bcs badint
				asl
				tax
				lda #$00				now clear it
				sta inttbl-2,x
				sta inttbl-1,x
				clc
				rts
irqrecev 		.EQ	*-ofsX
				lda accsav				get acc from where old ROM put it.
				sta p8areg
				stx p8xreg				entry point on ram card interrupt
				sty p8yreg
				tsx
				stx p8sreg
				lda irqflag				irq flag = 0 if old roms
				bne H315D				and 1 if new roms.
				pla	restore return address and p-reg.
				sta p8preg			 
				pla
				sta intadr				interrupt return address
				pla
				sta intadr+1
H315D  			txs
				lda mslot				set up to re-enable $Cn00 rom
				sta irqdev+2
				tsx	make sure stack has room for 16 bytes.
				bmi H3170				branch if stack ok
				ldy #$0F				otherwise, make room and save it.
H3169			pla
				sta svstack,y
				dey
				bpl H3169
H3170  			ldx #$FA				save 6 bytes of page 0
H3172  			lda	$00,x
				sta	svzerop-$FA,x
				inx
				bne	H3172

* poll interrupt routines for a claimer

				lda inttbl+1			test for a valid routine.
				beq intr2				branch if no routine.
				jsr goint1				execute
				bcc irqdone
intr2  			lda inttbl+3			repeat 3 more times
				beq intr3
				jsr goint2
				bcc irqdone
intr3  			lda inttbl+5
				beq intr4
				jsr goint3
				bcc irqdone
intr4  			lda inttbl+7
				beq H31A2
				jsr goint4
				bcc irqdone
H31A2  			inc irqcount			allow 255 unclaimed interrupts
				bne irqdone				before system death.
				lda #$01				bad irq so
				jsr sysdeath			kill the system.
irqdone			ldx #$FA
H31AE  			lda	svzerop-$FA,x		restore the zero page
				sta	$00,x
				inx
				bne H31AE
				ldx p8sreg				test if stack needs restoring.
				bmi H31C6				branch if not.
				ldy #$00
H31BD  			lda	svstack,y			restore stack
				pha
				iny
				cpy #$10
				bne H31BD
H31C6  			lda irqflag				check for old roms.
				bne H31DD				branch if new roms.
				ldy p8yreg				restore registers.
				ldx p8xreg
				lda CLRC8ROM			re-enable i/o card.
irqdev			.EQ	*-ofsX
				lda $C100				Cn is self modifying.
				lda irqdev+2			restore device id.
				sta mslot				slot being accessed.
H31DD  			jmp irqexit				do necessary bank switches and return.
irqflag			.EQ	*-ofsX
				.HS 00					0 = old roms. 1 = new roms.
irqcount 		.EQ	*-ofsX
				.HS 00					# of unclaimed interrupts.
svstack			.EQ	*-ofsX				temporary save area from stack
				.HS 0000000000000000
				.HS 0000000000000000
svzerop			.EQ	*-ofsX				temporary save area for zero page
				.HS 000000000000
goint1			.EQ	*-ofsX
				jmp (inttbl)			interrupt routine 1
goint2			.EQ	*-ofsX
				jmp (inttbl+2)			interrupt routine 2
goint3			.EQ	*-ofsX
				jmp (inttbl+4)			interrupt routine 3
goint4			.EQ	*-ofsX
				jmp (inttbl+6)			interrupt routine 4
syserr1			.EQ	*-ofsX
				sta p8error				P8 error code
				plx
				plx	pop 1 level of return
				sec
				rts
sysdeath1 		.EQ	*-ofsX
				tax	death error code.
				sta CLR80DISP			disable 80 col hardware.
				lda SETTEXT				switch in text.
				lda cortflag			is this a Cortland?
				beq H321A				if not, don't use super hires switch.
				stz newvideo			force off super hires.
H321A  			lda CLRPAGE2			switch in text page 1.
				ldy #$13
H321F  			lda #$20				inverse space border
				sta vline11+10,y
				sta vline13+10,y
				lda deathmsg,y
				sta vline12+10,y		'RESTART SYSTEM-$0x'
				dey
				bpl H321F
				txa	x = death error code
				and #$0F				convert to ascii
				ora #$B0
				cmp #$BA
				bcc H323B				branch if not > 9.
				adc #$06				inc to alpha a-f
H323B  			sta vline12+28			death error code 1 to F
H323E  			bra H323E				end of xdos mli

* ProDOS Block File Manager

bfmgr			.EQ	*-ofsX
				lda disptch,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 cmdtable,x			move address to indirect jump
				sta goadr
				lda cmdtable+1,x		high byte
				sta goadr+1
				lda #$20				init backup bit flag
				sta bkbitflg			to say 'file modified'
				bcc nopath
				jsr setpath				process pathname before calling command
				bcs errorsys			branch if bad name.
nopath			asl cmdtemp				test for refnum processing
				bcc nopreref
				jsr findfcb				set pointers to fcb and vcb of file
				bcs errorsys
nopreref 		asl cmdtemp				check for necessity of time stamp
				bcc H3274	
				jsr clockv				date/time
H3274  			jsr gocmd				execute command
				bcc goodop
errorsys 		jsr p8errv				P8 error vector
goodop			rts
setpath			.EQ	*-ofsX
				ldy #$01				index to pathname pointer
				lda (A3L),y				low pointer address
				sta zpt
				iny
				lda (A3L),y				hi pointer address
				sta zpt+1
synpath			.EQ	*-ofsX				entry used by rename for 2nd pathname.
				ldx #$00				x = index to pathbuf
				ldy #$00				y = index to input pathname.
				stx prfxflg				assume prefix is in use.
				stx pathbuf				mark pathbuf = nothing processed.
				lda (zpt),y				validate pathname length > 0 and < 65
				beq errsyn
				cmp #$41
				bcs errsyn
				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 '/')
				ora #$80
				cmp #$AF
				bne H32AD				branch if prefix appended.
				sta prfxflg				set prefix flag = prefix not used.
				iny	index to 1st character of pathname.
H32AD  			lda #$FF				set current position of pathbuf
				sta pathbuf,x			to indicate end of pathname.
				sta namcnt				$FF = no chars processed in local name.
				stx namptr				pointer to local name length byte.
H32B8  			cpy pathcnt				done with pathname processing?
				bcs endpath
				lda (zpt),y				get character
				and #$7F
				inx	prepare for next char
				iny
				cmp #$2F				is it delimiter '/' ?
				beq endname				yes
				cmp #$61				lowercase?
				bcc H32CD				no
				and #$5F				shift to uppercase
H32CD  			sta pathbuf,x			store char
				inc namcnt				is it the 1st char of a local name?
				bne H32DA				no
				inc namcnt				increment to 1
				bne H32E6				1st char must be alpha (always taken)
H32DA  			cmp #$2E				is it '.' ?
				beq H32B8				ok, then do next char
				cmp #$30				at least a '0' ?
				bcc errsyn				error if not
				cmp #$3A				is it numeric?
				bcc H32B8				yes, get next char
H32E6  			cmp #$41				at least an 'a' ?
				bcc errsyn				error if not
				cmp #$5B				is it > 'z' ?
				bcc H32B8				branch if valid alpha to get next char
errsyn			sec	bad pathname
				lda #$40
				rts
endpath			lda #$00			 	end pathname with a 0
				bit namcnt				also make sure count is positive
				bpl H32FD
				sta namcnt
				dex
H32FD  			inx
				sta pathbuf,x
				beq errsyn				error if '/' only.
				stx pathcnt				save length of pathname
				tax
endname  		lda namcnt				validate local name < 16
				cmp #$10
				bcs errsyn
				phx	save pointer
				ldx namptr				get index to beginning of local name
				sta pathbuf,x			save local name's length
				plx	restore pointer
				bne H32AD				branch if more names to process
				clc	probably no error, but
				lda prfxflg				make sure all pathnames are prefixed
				bne H3323				or begin with a '/'.
				lda newpfxptr			must be non-zero
				beq errsyn
H3323  			rts

* set prefix command

setprefx 		.EQ	*-ofsX
				jsr setpath				call is made to detect if a null path.
				bcc H3333				path ok.
				ldy pathbuf				is it a null pathname?
				bne pfxerr				error if not
				jsr stypfx				indicate null prefix
				clc	no error
				rts
H3333  			jsr findfile			go find specified prefix directory.
				bcc H333C				if no error.
				cmp #$40				bad pathname.
				bne pfxerr				branch if error is not root directory.
H333C  			lda d_stor				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 H334D
				lda newpfxptr			append new prefix to old
H334D  			tay
				sec	find new beginning of prefix
				sbc pathcnt
				cmp #$C0				too long?
				bcc errsyn				then error
				tax
				jsr stapfx
				lda d_dev				save device #
				sta p_dev
				lda d_frst				and address of 1st block
				sta p_blok
				lda d_frst+1
				sta p_blok+1
movprfx			lda pathbuf,y
				sta pathbuf,x
				iny
				inx
				bne movprfx
				clc						good prefix
				rts
ptyperr			lda #$4B				filetype error (not a directory)
pfxerr			sec
				rts

* get prefix command

getprefx 		.EQ	*-ofsX				calc how big a buffer is needed.
				clc	get index to users pathname buffer
				ldy #$01
				lda (A3L),y
				sta usrbuf				user buffer ptr
				iny
				lda (A3L),y
				sta usrbuf+1
				stz cbytes+1			set buffer length at 64 char max
				lda #$40
				sta cbytes
				jsr valdbuf				go validate prefix buffer address
				bcs pfxerr
				ldy #$00				y = indirect index to user buffer.
				lda newpfxptr			get address of beginning of prefix
				tax
				beq nulprfx				if null prefix.
				eor #$FF				get total length of prefix
				adc #$02				add 2 for leading and trailing slashes.
nulprfx  		sta (usrbuf),y			store length in user's buffer.
				beq gotprfx				branch if null prefix.
sendprfx 		iny	inc to next user buffer location.
				lda pathbuf,x			get next char of prefix.
sndlimit 		sta (usrbuf),y		  	give char to user.
				and #$F0				check for length descriptor.
				bne H33B3				branch if regular character
				lda #$2F				otherwise, substitute a slash.
				bne sndlimit			branch always
H33B3  			inx
				bne sendprfx			branch if more to send.
				iny
				lda #$2F				end with '/'
				sta (usrbuf),y
gotprfx  		clc	no error
				rts
findfcb			.EQ	*-ofsX
				ldy #$01				index to ref#
				lda (A3L),y				is it a valid file# ?
				beq badref				must not be 0.
				cmp #$09				must be 1 to 8 only.
				bcs badref
				pha
				dec 
				lsr
				ror
				ror
				ror					multiply by 32.
				sta fcbptr				used as an index to fcb
				tay
				pla	restore ref# in acc
				cmp fcbbuf,y
				bne errnoref
fndfcbuf 		.EQ	*-ofsX				get page address of file buffer.
				lda fcbbuf+11,y
				jsr getbufadr			get file's address into bufaddrl,h
				ldx bufaddrh			(y=fcbptr preserved)
				beq fcbdead				fcb corrupted
				stx datptr+1			save ptr to data area of buffer
				inx
				inx	index block always 2 pages after data
				stx zpt+1
				lda fcbbuf+1,y			also set up device #
				sta devnum
				lda bufaddrl
				sta datptr				index and data buffers always on
				sta zpt					page boundaries.
fndfvol			tax	search for associated vcb
				lda vcbbuf+16,x
				cmp fcbbuf+1,y			is this vcb the same device?
				beq tstvopen			if it is, make sure volume is active.
nxtfvol			txa					 	adjust index to next vcb.
				clc
				adc #$20
				bcc fndfvol				loop until volume found.
				lda #$0A				open file has no volume so
				jsr sysdeath			kill the system.
fcbdead			lda #$0B				fcb error so
				jsr sysdeath			kill the system.
tstvopen 		lda vcbbuf,x			make sure this vcb is open.
				beq nxtfvol				branch if it is not active.
				stx vcbptr				save ptr to good vcb.
				clc	no error
				rts
errnoref 		lda #$00				put a zero into this fcb to
				sta fcbbuf,y			show free fcb.
badref 			lda #$43				requested refnum is
				sec	illegal (out of range)
				rts

* online command

online			.EQ	*-ofsX				move user spec'd buffer ptr to usrbuf.
				jsr mvdbufr				figure out how big buffer has to be.
				stz cbytes				set this for valdbuf routine.
				stz cbytes+1
				ldy #$01
				lda (A3L),y				if 0 then cbytes=$100 else $010 for one
				and #$F0				device. mask out unused nibble.
				sta devnum				last device used.
				beq H343C				branch if all devices.
				lda #$10				cbytes = $010
				sta cbytes
				bne H343F				always taken
H343C  			inc cbytes+1			cbytes = $100
H343F  			jsr valdbuf				go validate buffer range against
				bcs onlinerr			allocated memory.
				lda #$00				zero out user buffer space
				ldy cbytes
H3449  			dey
				sta (usrbuf),y
				bne H3449
				sta namptr				used as pointer to user buffer.
				lda devnum				get device # again.
				bne H3474				branch if only 1 device to process.
				jsr mvdevnums			get list of currently recognized dev's.
H3459  			phx	save index to last item on list
				lda loklst,x
				sta 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 H3459				branch if there is another device.
				lda #$00				no errors for multiple on-line
				clc
onlinerr 		rts
online1			.EQ	*-ofsX
H3474  			jsr fnddvcb				see if it has already been logged in.
				bcs olinerr1			branch if vcb is full.
				ldx #$00				read in root (volume) directory
				lda #$02
				jsr rdblk				read it into general purpose buffer.
				ldx vcbptr				index to the vcb entry.
				bcc volfound			branch if read was ok.
				tay	error value.
				lda vcbbuf+17,x			don't take the vcb offline if
				bne rtrnerr				there are active files present.
				sta vcbbuf,x			now take the volume offline
				sta vcbbuf+16,x
rtrnerr			tya	error value.
				bcs olinerr1			branch if unable to read.
volfound 		lda vcbbuf,x			has it been logged in before?
				beq H349E				if not.
				lda vcbbuf+17,x			it has, are there active files?
				bmi H34AA				branch if volume is currently busy.
H349E  			jsr logvcb1				go log it in.
				bcs olinerr1			branch if there is a problem.
				lda #$57				anticipate a duplicate active volume
				bit duplflag			exits.
				bmi olinerr1			branch if so.
H34AA  			ldx vcbptr
				jsr cmpvcb				does vol read compare with logged vol?
				lda #$2E				anticipate wrong volume mounted.
				bcc H34D0				branch if ok.
olinerr1 		pha	save error code.
				jsr svdevn				report what device has problem.
				pla	error code.
				iny	tell what error was encountered.
				sta (usrbuf),y
				cmp #$57				duplicate volume error?
				bne H34CE				no.
				iny	report which other device has same name
				ldx vcbentry
				lda vcbbuf+16,x
				sta (usrbuf),y
				stz duplflag			clear duplicate flag.
				lda #$57				duplicate volume error code.
H34CE  			sec	flag error
				rts
H34D0  			lda vcbbuf,x			get volume name count
				sta namcnt
				ldy namptr				index to user's buffer.
H34D9  			lda vcbbuf,x			move name to user's buffer
				sta (usrbuf),y
				inx
				iny
				dec namcnt
				bpl H34D9
svdevn			.EQ	*-ofsX
				ldy namptr				index to 1st byte of this entry.
				lda devnum				upper nibble = device# and
				ora (usrbuf),y			lower nibble = name length.
				sta (usrbuf),y
				clc	no errors
				rts	end of block file manager

MAN
SAVE USR/SRC/PRODOS.203/PRODOS.S.XDOS.A
LOAD USR/SRC/PRODOS.203/PRODOS.S
ASM