	KEEP	PRODOS
	MCOPY	PRODOS.MAC

* disassembly of prodos version 2.0.3
* can be compiled with the orca/m assembler
*    which produces an output file PRODOS (type = EXE)
* address refs beginning with 'L' were generated by orca disassembler
* address refs beginning with 'H' were added manually

* last edit: 01/24/13

* map of the object modules within prodos exe are as follows:

*  $2000 mli_0    mli loader/relocator
*  $2C80 ram_1    installer for /RAM
*  $2D00 ram_2    /RAM driver in main lc
*  $2D9B mli_3    interrupts
*  $2E00 mli_1    global page
*  $2F00 tclock_0 Thunderclock driver
*  $2F80 cclock_0 Cortland clock driver
*  $3000 mli_2    xdos mli & block file manager
*  $5100 ram_0    /RAM driver in aux mem
*  $5300 xrw_0    disk core routines
*  $5A00 sel_0    dispatcher
*  $5D00 sel_1    enhanced quit code (Bird's Better Bye)
*  $6000 sel_2    GQuit dispatcher support

************************    IMPORTANT    ************************
*                                                               *
* 1. In the language card area, the $D000 areas overlay. To     *
*    determine which bank is active requires that the main bank *
*    has a CLD ($D8) at $D000 and the alternate bank does not.  *
*    $D000 in ROM = $6F, LC bank1 = $D8, LC bank2 = $EE         *
*                                                               *
* 2. Location $E000 is used to determine the state of ROM vs.   *
*    language card. Therefore, the value of $E000 in the MLI    *
*    and ROM must differ.                                       *
*                                                               *
* 3. In the section MEMMGR, the routine CALLDISP must access    *
*    the other $D000 bank so it MUST reside ABOVE $E000 in the  *
*    language card area.                                        *
*                                                               *
* 4. The Disk II routine xrwtot MUST reside on a page boundary  *
*    to distinguish it from a ram-based driver.                 *
*                                                               *
* 5. In the /RAM driver ram3, the byte at $FF58 MUST be an rts  *
*    ($60) so the routine JSR $FF58 to determine an I/O card's  *
*    slot still works when the language card is switched in.    *
*                                                               *
*****************************************************************

PRODOS	START

* Predefined labels:

lookptr	equ	$0A
idapple	equ	$0C		model machine id
idxl	equ	$10		general use 16 bit index pointer
devid	equ	$12
src	equ	$12
dst	equ	$14
cnt	equ	$16
cde	equ	$18
ecde	equ	$1A
wndlft	equ	$20
wndwdth	equ	$21
wndtop	equ	$22
wndbtm	equ	$23
ch	equ	$24		cursor horizontal
cv	equ	$25		cursor vertical
invflg	equ	$32		inverse flag
pcl	equ	$3A
pch	equ	$3B
A1L	equ	$3C
A1H	equ	$3D
A2L	equ	$3E
A2H	equ	$3F
A3L	equ	$40
A4L	equ	$42
unitnum	equ	$43
buf	equ	$44		2-byte data buffer pointer which
accsav	equ	$45		overlaps accsav (temp acc save byte)
bloknml	equ	$46		used mostly as 16 bit block # pointer
zpt	equ	$48		highly used zero page index pointer
datptr	equ	$4A		ptr to data area of buffer.
sos	equ	$4C		sos buffer pointer.
usrbuf	equ	$4E		data ptr in user buffer.

* zero page variables for Bird's Better Bye

smparms	equ	$60		set mark parms
sm_refn	equ	$61		file reference number
fpos_lo	equ	$62		new file position (3 bytes)
fpos_mid equ	$63
fpos_hi	equ	$64
lstpntr	equ	$65		device list pointer (16 bit)
valcnt	equ	$67		name counter
filecount equ	$68		# of displayable files in directory
namelen	equ	$69		length of filename
gp_cnt	equ	$6A		general purpose counter
dlevel	equ	$6B		directory level
fnstore	equ	$6C		filename storage pointer (16 bit)
entlen	equ	$6E		directory entry length
entblk	equ	$6F		directory entries/block
filecnt	equ	$70		directory file count (16 bit)
blkfl	equ	$72		block flag / file counter
topname	equ	$73		index # of top name in display
filetyps equ	$74		128 byte table of filetypes

errnum	equ	$DE
tst128	equ	$0080		temp page 0 routine for memory test
auxsp	equ	$0101
ramdest	equ	$0200		load address for aux bank /RAM driver
inbuf	equ	$0200		keyboard buffer
pbuf	equ	$0280		prefix buffer
p3vect	equ	$03F0		page 3 vectors (16 bytes)
softev	equ	$03F2		RESET vector
pwredup	equ	$03F4		power up byte
nmivect	equ	$03FB		nmi handler
txtp2	equ	$0400		test location for aux card
vline10	equ	$04A8		line 10 of display
vmode	equ	$04FB		video firmware operating mode
vline11	equ	$0528		line 11 of display
clkmode	equ	$0538		clock mode
ch80col	equ	$057B		80 column ch position
vline12	equ	$05A8		line 12 of display
vline5	equ	$0600		line 5 of display
vline13	equ	$0628		line 13 of display
vline14	equ	$06A8		line 14 of display
vline23	equ	$0750		line 23 of display
vline16	equ	$07A8		line 16 of display
vline24	equ	$07D0		line 24 of display
mslot	equ	$07F8		slot being accessed
lodintrp equ	$0800
dbuf	equ	$0C00		8 page directory buffer
vblock1	equ	$0E00		ramdisk directory block
volbuf	equ	$0F00		volume buffer
dispadr	equ	$1000		system death dispatcher run address
iobuf	equ	$1400		i/o buffer
fbuf	equ	$1800		FCB buffer
op_buf	equ	$1C00		open file buffer (selector)
sysentry equ	$2000		.SYS file load address
prodos8	equ	$BF00		prodos MLI and global page
kbd	equ	$C000		keyboard latch (read)
store80off equ	$C000		disable 80-col store (write)
store80on equ	$C001		enable 80-col store
rdmainram equ	$C002		read from main 48K
rdcardram equ	$C003		read from alt 48K
wrmainram equ	$C004		write to main 48K
wrcardram equ	$C005		write to alt 48K
setstdzp equ	$C008		use main zero page/stack
setaltzp equ	$C009		use alt zero page/stack
int3rom	equ	$C00A		enable internal slot 3 ROM
slot3rom equ	$C00B		enable external slot 3 ROM
clr80vid equ	$C00C		disable 80 col hardware
clraltchar equ	$C00E		normal LC, flashing UC
kbdstrobe equ	$C010		turn off keypressed flag
rd80col  equ	$C018		if 80-column store
newvideo equ	$C029		video mode select
spkr     equ	$C030		click speaker
txtset   equ	$C051		switch in text
txtpage1 equ	$C054		switch in text page 1
txtpage2 equ	$C055		switch in text page 2
statereg equ	$C068		memory state register
phaseoff equ	$C080		disk port
romin1	equ	$C081		read ROM/write RAM bank 2
romin	equ	$C082		read ROM
altram	equ	$C083		read/write RAM bank 2
motoroff equ	$C088		disk port
motoron	equ	$C089		disk port
drv0en	equ	$C08A		disk port
ramin	equ	$C08B		read/write RAM bank 1
q6l	equ	$C08C		disk port
q6h	equ	$C08D		disk port
q7l	equ	$C08E		disk port
q7h	equ	$C08F		disk port
rdtcp	equ	$C108		Thunderclock read entry
wttcp	equ	$C10B		Thunderclock write entry
init80	equ	$C300		init 80 col card
slot3id1 equ	$C305		slot 3 card id 1
slot3id2 equ	$C307		slot 3 card id 2
slot3id3 equ	$C30B		slot 3 card id 3
ext80col equ	$C30C		slot 3 80 col id
auxmove	equ	$C311		move (3C)-(3E) to (42)
xfer	equ	$C314
slot3irq equ	$C3FA		slot 3 irq handler
clrrom   equ	$CFFF		switch out $C8 ROMs
rwts	equ	$D000		disk ii driver in bank 1
displc2	equ	$D100		system death routine stored in bank 2
pathbuf	equ	$D700		pathname buffer
tclk_in	equ	$D742		clock driver in bank 2
fcbbuf	equ	$D800		fcb buffer
vcbbuf	equ	$D900		vcb buffer
bmbuf	equ	$DA00		512 byte bitmap buffer
gbuf	equ	$DC00		general purpose 512 byte block buffer
xdosorg	equ	$DE00		xdos MLI in aux memory
romirq	equ	$FA41		monitor irq entry
breakv	equ	$FA59		monitor break vector
resetv	equ	$FA62		monitor reset entry
HFB1E	equ	$FB1E		version check byte
init     equ	$FB2F		init text screen
settxt   equ	$FB39		set text mode
tabv     equ	$FB5B		set vertical position
setpwrc  equ	$FB6F		create power-up byte
version  equ	$FBB3		monitor ROM id byte
zidbyte  equ	$FBC0		monitor ROM id byte
bell1    equ	$FBDD		generate bell tone
home     equ	$FC58		home cursor and clear screen
clreol   equ	$FC9C		clear to end of line
rdkey    equ	$FD0C		input char with cursor
crout    equ	$FD8E		issue carriage return
cout     equ	$FDED		output character
idroutine equ	$FE1F		returns system info
setinv   equ	$FE80		set inverse text mode
setnorm  equ	$FE84		set normal text mode
setkbd   equ	$FE89		reset input to keyboard
setvid   equ	$FE93		reset output to screen
lcdest	equ	$FF00		load address
bell     equ	$FF3A		output bell (ctl-G)
oldrst   equ	$FF59		monitor reset entry
* romrts equ	$FFCB		an rts location that must be in ROM
P8QUIT	equ	$E0D000
GSOS     equ	$E100A8
GSOS2    equ	$E100B0
OS_BOOT  equ	$E100BD		indicates O/S initially booted

* object code = mli_0
* mli loader/relocater
* 1st instruction MUST be a jmp ($4C)

H2000	jmp   prostart
	jmp   atalkset			appletalk setup for network boot
	jmp   p16start			GQuit setup for gs/os
	LONGI	OFF
	LONGA	OFF
	msb	on
H2009	dc	c'Apple II'
H2011	dc	c'ProDOS 8 V2.0.3      '
	dc	c'06-May-93'
H202F	dc	c'            '
H203B	dc	c'Copyright Apple Computer, Inc., 1983-93'
H2062	dc	c'All Rights Reserved.'
p16start inc   setuprts			set = 2 for GQuit rts
atalkset inc   setuprts			set = 1 for appletalk rts
prostart lda   unitnum
         sta   H231D
         jsr   H2622

* test for at least a 65c02

         sed
         lda   #$99			a negative #
         clc
         adc   #$01			+1 in decimal = 0 (positive)
         cld
         bmi   m48k			if 6502 because will not clear N flag

* machine at least an m65c02

         lda   #$01			patch for the gs rom
         trb   statereg			to force off intcxrom
         ldx   #<H232B			yx=232B location table
         ldy   #>H232B
         jsr   reloc			move interpreter loader to $800
         bcs   m48k			error

* test for at least 64k

         ldy   #$00
         lda   #$FF
         sta   kversion			at least 48k ?
         eor   kversion
         sec
         bne   m48k                    	if not.
         sta   kversion                 try again to be sure
         lda   kversion
         bne   m48k                     still not.
         lda   romin			read ROM
         jsr   whchrom			get preliminary system config
         bcs   m48k			machine too small
         lda   idapple
         and   #$20
         bne   m64k                     if at least 64k //+.
m48k     jmp   H22EB                    need enhanced IIe

* we have 64k, now determine model: //e , iic, or Cortland (//gs)

m64k     ldx   #<H2367			yx=2367 relocation table
         ldy   #>H2367
         jsr   reloc
         lda   kversion
         sta   xdosver			save current version for dir use
H20CE    bcc   H20D3
         jmp   relocerr
H20D3    lda   romin			read ROM
         ldx   version                  ROM id byte
         cpx   #$06
         bne   H211D			then it's a //e
         lda   #$E0
         bit   zidbyte                  another ROM id byte
         php
         lda   idapple
         and   #$37
         plp
         bvc   set3			if //c or //x
         bmi   set7			if //e
set3     php
         ora   #$08
         plp
         bpl   mach2			if //c
         ora   #$40
         bpl   H20FD                    always taken.
mach2    inc   cflag			//c or later
         bvs   H20FD
set7     ora   #$80
H20FD    sta   idapple
         lda   romin			read ROM
         sec
         jsr   idroutine                returns system info
         bcs   H211D                    branch if // family
         inc   cortland                 it's a Cortland, set loader flag
         stz   vmode			force setvid to reset cursor
         jsr   setvid                   reset output to screen
         lda   setuprts
         bne   H211D                    branch if prodos 8 alone

* running from gs/os shell so zero out os_boot for appletalk

         sta   >OS_BOOT                 indicates O/S initially booted.
         jsr   patch101                 patch for gs/os - rev note #101

* put dispatcher in bank 2 of language card

H211D    lda   H231D                    place boot devnum in globals
         sta   H2324
         sta   devnum                   last device used
         jsr   devsrch			finish setting up globals
         lda   H2324
         sta   devnum
         jsr   lc1in			switch in language card bank 1.
         ldx   #<rlclk64                set up clock
         ldy   #>rlclk64
         jsr   reloc
H2139    bcs   H20CE
         lda   #<calldisp
         sta   jspare+1			P8 system death vector
         lda   #>calldisp
         sta   jspare+2
         lda   altram			read/write RAM bank 2
         lda   altram
         ldx   #<altdsptbl		GQuit dispatcher
         ldy   #>altdsptbl
         lda   setuprts
         cmp   #$02			is this a GQuit setup?
         beq   H216E			taken to use GQuit dispatcher.
         ldx   #<newquitbl		else, use Bird's Better Bye
         ldy   #>newquitbl              if correct machine.
         lda   machid                   machine ID byte
         bit   #$00                     //c ?
         bne   H216E                    if yes, can use.
         and   #$C2
         cmp   #$82                     //e with 80 col card ?
         beq   H216E                    if yes, can use.
         ldx   #<dsp64			else, use original quit code
         ldy   #>dsp64
         inc   newquitflag		using old quit code so set flag
H216E    jsr   reloc
         lda   #$EE			byte to distinguish LC bank 2
         sta   $D000
         jsr   lc1in			switch in LC bank 1
         bcs   H2139

* test for 128k needed to install ram disk

         lda   machid                   machine ID byte
         and   #$30
         eor   #$30
         bne   noramdsk	if < 128k
         ldx   #$FF
         php				save interrupt status
         pla                            in acc.
         sei                            no interrupts.
         sta   setaltzp                 use alt zero page/stack
         stx   auxsp                    init aux sp to $FF
         sta   setstdzp                 use main zero page/stack
         pha                            restore interrupt status
         plp
         sta   int3rom              	enable internal slot 3 ROM
         jsr   H2C80			install ram disk

* check interrupt vector to determine ROM version

noramdsk lda   romin1                   read ROM/write RAM bank 2
         ldy   irqv                     interrupt vector
         ldx   irqv+1                   x = high byte
         jsr   lc1in			set language card bank 1 to r/w
         cpx   #$D0                     is it > $D000 (old roms)
         lda   #$00
         bcs   H21C5                    branch if old roms
         sta   setaltzp                 use alt zero page/stack
         lda   #$FF                     set aux sp = $FF
         sta   auxsp
         stx   irqv+1                   interrupt vector
         sty   irqv                     save irq vector in aux lc
         sta   setstdzp                 use main zero page/stack
         stx   irqv+1                   save irq vector in main lc
         sty   irqv
         lda   #$01
H21C5    sta   irqflag			1 = new roms
         stz   cortflag			assume not Cortland system
         lda   cortland                 running on a Cortland ?
         beq   H21D5                    branch if not.
         inc   cortflag                 yes it's Cortland
         bra   docard

* check for a rom in slot 3. if no rom, use internal $C300 firmware

H21D5    sta   int3rom			enable internal slot 3 ROM
         lda   rommap                   slot ROM bit map
         and   #$08			mask all but slot 3
         bne   isromin3                 taken if rom in slot 3
         bra   H2247                    else continue booting

* found a rom in slot 3. is it an external, identifiable 80 col card
* with interrupt routines? if so, enable it else use internal $C300 firmware.

isromin3 sta   slot3rom                 enable slot 3 rom
         lda   slot3id1                 check card id bytes
         cmp   #$38
         bne   hitswtch                 not terminal card
         lda   slot3id2
         cmp   #$18
         bne   hitswtch	
         lda   slot3id3
         cmp   #$01
         bne   hitswtch
         lda   ext80col			is it an apple 80 col compatible card?
         and   #$F0
         cmp   #$80
         bne   hitswtch                 if not.
         lda   machid                   machine ID byte
         and   #$C8
         cmp   #$C0                     is it a //+ ?
         beq   docard                   yes
         lda   slot3irq
         cmp   #$2C                     does card have an interrupt handler?
         beq   docard                   yes
hitswtch sta   int3rom			enable internal $C300 firmware

* verify that the card in aux slot is actually present

         sta   store80on                enable 80-col store
         sta   txtpage2                 switch in text page 2
         lda   #$EE
         sta   txtp2
         asl   a
         asl   txtp2
         cmp   txtp2
         bne   H2230
         lsr   a
         lsr   txtp2
         cmp   txtp2
H2230    sta   txtpage1			main memory
         sta   store80off		disable 80-col store
         beq   docard                   branch if card is there
         lda   machid                   machine ID byte
         and   #$FD                     clear 80-col bit 2 (no card)
         bne   H2244                    always
docard   lda   machid
         ora   #$02			turn bit 2 on (80-col card is present)
H2244    sta   machid
H2247    lda   cortland			are we running on a //gs ?
         beq   H225D                    if not.
         lda   #$4C                     enable clock routine by putting a jmp
         sta   clockv                   in front of clock vector
         ldx   #<cortclock              yx = relocation table
         ldy   #>cortclock              for cortland clock driver
         jsr   reloc
         lda   #$01			set bit 0 = clock present
         tsb   machid
H225D    lda   setuprts			get setup entry point flag
         beq   H2267                    taken if normal boot.
         lda   romin                    read ROM
         rts                            return to caller at setup entry point.
setuprts dc    i1'$00'                  0 = normal boot, <>0 = return

* set prefix to boot device

H2267    jsr   prodos8                  online
         dc    i1'$C5'
         dc    i2'H231C'
         bcs   relocerr
         lda   pbuf+1			get volume name length.
         and   #$0F                     strip devnum
         beq   relocerr
         inc   a                        add 1 for leading '/'
         sta   pbuf                     save prefix length.
         lda   #$2F                     place leading '/' in prefix buffer
         sta   pbuf+1
         jsr   prodos8                  set prefix
         dc    i1'$C6'
         dc    i2'H2320'
         bcs   relocerr
         tax				=0
         stx   dst
         ldy   #$02                     read directory into buffer
         lda   #>dbuf	
H228E    sta   dst+1
         sta   H2325+1
         sty   H2327
         stx   H2327+1
         jsr   prodos8                  read block
         dc    i1'$80'
         dc    i2'H2323'
         bcs   relocerr
         ldy   #$03			get next block# from link
         lda   (dst),y
         tax
         dey
         ora   (dst),y			if both bytes are the same
         beq   H22B7                    then no more blocks of directory.
         lda   (dst),y
         tay
         lda   dst+1
         clc
         adc   #$02			add $200 to buffer pointer
         cmp   #>dbuf+$800              until it points past end of buffer.
         bcc   H228E                    if ok, read next block.
H22B7    jmp   lodintrp			jmp to 'licode' (load interpreter)

* relocation/configuration error

relocerr sta   romin			read ROM
         jsr   home
         ldy   #$1D
H22C2    lda   H22CD,y
         sta   vline12+4,y
         dey
         bpl   H22C2
H22CB    bmi   H22CB
H22CD    dc    c'Relocation/Configuration Error'
H22EB    ldy   #$23
H22ED    lda   H22F8,y
         sta   vline14+2,y
         dey
         bpl   H22ED
H22F6    bmi   H22F6
H22F8    dc    c'REQUIRES ENHANCED APPLE IIE OR LATER'
H231C    dc    i1'$02'
H231D    dc    i1'$60'
         dc	i2'pbuf+1'
H2320    dc    i1'$01'                  parm count
         dc    i2'pbuf'			buffer
H2323    dc    i1'$03'                  parm count
H2324    dc    i1'$00'                  unit number
H2325    dc    i2'$0000'                2 byte data buffer
H2327    dc    i2'$0000'                2 byte block number
cortland dc    i1'$00'			cortland loader flag (1 = Cortland)
newquitflag dc i1'$00'                  1 = old quit code

H232B    dc    i1'$01'                  move interpreter loader code
         dc    i2'lodintrp'             destination address
         dc    i2'H257B-licode'		length to move
         dc    i2'licode'               source address
         dc    i1'$01'                  move $3F0 vectors
         dc    i2'p3vect'               destination
         dc    i2'$0010'                16 bytes to move
         dc    i2'H257B'		source
         dc    i1'$01'
         dc    i2'lookptr'
         dc    i2'$0002'
         dc    i2'dst'
         dc    i1'$01'                  move 128k test to zero page
         dc    i2'tst128'		destination
         dc    i2'H2622-H25DC'		length
         dc    i2'H25DC'                source
         dc    h'FF'                    done
dsp64    dc    i1'$01'                  move p8 dispatcher code
         dc    i2'displc2'              destination
         dc    i2'birdbye-disp1obj'	length (must be <= 3 pages)
         dc    i2'disp1obj'             source
         dc    h'FF'                    done
newquitbl dc   i1'$01'                  move Bird's Bye code
         dc    i2'displc2'              dest
         dc    i2'GQdisp-birdbye'	length (must be <= 3 pages)
         dc    i2'birdbye'              source
         dc    h'FF'                    done
altdsptbl dc   i1'$01'                  move GQuit launcher
         dc    i2'displc2'		destination
         dc    i2'$0300'                length (must be <= 3 pages)
         dc    i2'GQdisp'               source
         dc    i1'$01'                  move a copy of GQuit launcher
         dc    i2'dispadr'              to dispadr for gsos
         dc    i2'$0300'                length (must be <= 3 pages)
         dc    i2'GQdisp'               source
         dc    h'FF'	done

* tables for moving 64k version of mli for execution

H2367    dc    i1'$01'                  relocation table. 1=move src to dst
         dc    i2'lanirq'               destination
         dc    i2'H2E00-H2D9B'		length to move
         dc    i2'H2D9B'                source
         dc    i1'$01'
         dc    i2'prodos8'		globals
         dc    i2'$0100'		in one page
         dc    i2'H2E00'
         dc    h'00'			0=clear buffers $D700-$DDFF
	dc	i2'pathbuf'
	dc	i2'xdosorg-pathbuf'
         dc    i1'$01'
         dc    i2'xdosorg'
         dc    i2'ramsrc-xdosobj'	length of mli
         dc    i2'xdosobj'
         dc    i1'$01'
         dc    i2'rwts'
         dc    i2'disp1obj-blockio'	length of disk ii driver
         dc    i2'blockio'
         dc    h'FF'			done

* move thunderclock

rlclk64  dc    i1'$01'                  relocation table. 1=move src to dst
         dc    i2'tclk_in'		destination
         dc    i2'tclk_end-tclock_0'	length of thunderclock driver
         dc    i2'tclock_0'		source
         dc    i1'$04'                  4=relocate and move program
         dc    i2'tclk_in'
         dc    i2'H2F69-tclock_0'
         dc    i2'tclk_in'
         dc    h'00'
	dc	h'C1C1'
clock64	dc    i1'$00'
         dc    h'FF'			done

* move cortland clock

cortclock dc   i1'$01'                  relocation table. 1=move src to dst
         dc    i2'tclk_in'		destination
         dc    i2'cclk_end-cclock_0'	length of cortland clock driver
         dc    i2'cclock_0'		source
         dc    h'FF'			done

* load and run appletalk configuration file (atinit) if present
* or continue loading and running .system file

* loader origin $800

ofsL	equ	licode-lodintrp		offset from loader org

licode   jsr   prodos8                  check for file 'atinit'
         dc    i1'$C4'
         dc    i2'gfi_list'
         bcc   gfi_ok                   branch if 'atinit' file found
         cmp   #$46			file not found?
         beq   H23DF                    if so, continue loading interpreter
         bne   H23E2
gfi_ok   lda   gfi_type
         cmp   #$E2			is 'atinit' correct file type?
         bne   H23E2			error - wrong file type
         jsr   prodos8                  open 'atinit' file
         dc    i1'$C8'
         dc    i2'atopen'               parms
         bne   H23E2                    error
         lda   #$9F			max size = 39.75k ($2000-$BF00)
         sta   rdlen+1
         stz   rdlen
         jsr   prodos8                  read 'atinit' file to 'sysentry'
         dc    i1'$CA'
         dc    i2'rdparm'
         bne   H23E2                    error - too big
         jsr   prodos8                  close 'atinit' file
         dc    i1'$CC'
         dc    i2'clparm'
         bne   H23E2                    error
         lda   romin			enable ROM
         jsr   sysentry			execute ATinit
H23DF    jmp   goloadint		execute .system file

* fatal error

H23E2    ldx   H23F0
H23E5    lda   H23F0,x
         sta   vline16,x
         dex
         bne   H23E5
H23EE    beq   H23EE			hang
H23F0	dc	i1'$1A'			length of message
	dc    c'Unable to load ATInit file'
gfi_list equ	*-ofsL
         dc    h'0A'
	dc	i2'atinitname'
	dc	h'00'
gfi_type equ	*-ofsL
	dc	h'00000000'
         dc    h'0000000000000000'
         dc    h'0000'
atopen	equ	*-ofsL			parms to open 'atinit'
	dc	h'03'
	dc	i2'atinitname'
	dc	i2'iobuf'		i/o buffer
         dc	h'01'                    ref# hard coded since no other files
atinitname equ	*-ofsL
         dc    h'06'			length of name
	dc	c'atinit'                name of appletalk config file
goloadint equ	*-ofsL
         lda   #>dbuf			search directory buffer
         sta   idxl+1
         lda   #$04                     start 1 entry past header
         bne   H2434                    always.
H2432    lda   idxl			calc next entry position
H2434    clc
         adc   dbuf+35                  inc to next entry address
         sta   idxl
         bcs   H2451                    branch if page cross.
         adc   dbuf+35                  test for end of block.
         bcc   H2453                    branch if not page cross
         lda   idxl+1
         lsr   a                        end of block?
         bcc   H2453                    no.
         cmp   #$09                     end of directory?
         bne   H244D                    no.
         jmp   nointrp			no interpreter, go quit.
H244D    lda   #$04			reset index to 1st entry in next block.
         sta   idxl
H2451    inc   idxl+1			inc to next page.
H2453    ldy   #$10                     check file type.
         lda   #$FF                     must be a prodos sys file
         eor   (idxl),y
         bne   H2432                    if not sys.
         tay                            see if active
         lda   (idxl),y
         beq   H2432                    if deleted file.
         and   #$0F                     strip file 'kind'.
         sta   pbuf                     save length of name.
         cmp   #$08                     must be at least 'x.system'
         bcc   H2432                    else, ignore it.
         tay                            compare last 7 chars for '.system'
         ldx   #$06
H246C    lda   (idxl),y
         eor   iterp,x
         asl   a
         bne   H2432			branch if something else
         dey
         dex
         bpl   H246C
         ldy   #$00
H247A    iny
         lda   (idxl),y
         sta   pbuf,y
         ora   #$80			msb on so can be displayed if error
         sta   iomess+$11,y
         cpy   pbuf
         bne   H247A
         lda   #$A0			space after name
         sta   iomess+$12,y
         tya	                         error message length
         adc   #$13                     (carry set)
         sta   ierlen
         jsr   prodos8                  open interpreter file
         dc    i1'$C8'
         dc    i2'opparm'
         bne   badlod
         jsr   prodos8                  get eof (length of file)
         dc    i1'$D1'
         dc    i2'efparm'
         bne   badlod
         lda   eof+2
         bne   toolong
         lda   eof+1
         cmp   #$9F			max size = 39.75k ($2000-$BF00)
         bcs   toolong
         sta   rdlen+1
         lda   eof
         sta   rdlen			(read entire file)
         jsr   prodos8                  read interpreter file
         dc    i1'$CA'
         dc    i2'rdparm'
         beq   H24C8			go close if successfully read.
         cmp   #$56                     memory conflict?
         beq   toolong                  then too large
         bne   badlod                   else, unable to load.
H24C8    jsr   prodos8                  close interpreter file
         dc    i1'$CC'
         dc    i2'clparm'
         bne   badlod                   hopefully never taken

* if booting on a //c then see if esc is in keyboard buffer
* and clear it. it may have been pressed to shift speed
* of accelerator chip

         lda   cflag
         beq   H24DF			taken if not booting on a //c
         lda   kbd                      else, check for keypress
         cmp   #$9B                     escape?
         bne   H24DF                    if not.
         sta   kbdstrobe                clear keyboard
H24DF    lda   romin			enable ROM
         jmp   sysentry			go run interpreter
cflag	equ	*-ofsL
         dc    h'00'			set if a //c.
nointrp	equ	*-ofsL			no interpreter found,
         jsr   prodos8                  so quit.
         dc    i1'$65'
         dc    i2'quitparm'
badlod	ldy   ierlen			center the error message
         lda   #$27
         sec
         sbc   ierlen
         lsr   a
         adc   ierlen
         tax
H24FA    lda   iomess,y
         sta   vline16,x
         dex
         dey
         bpl   H24FA
         bmi   H2511
toolong  ldy   #$1E
H2508    lda   lgmess,y
         sta   vline16+5,y
         dey
         bpl   H2508
H2511    bmi   H2511
lgmess	equ	*-ofsL
         dc    c'**  System program too large  **'
iomess	equ	*-ofsL
         dc    c'** Unable to load'
	dc	c' X.System *********'
ierlen	equ	*-ofsL
         dc    h'00'
opparm	equ	*-ofsL			parms for open call
	dc	h'03'
	dc	i2'pbuf'
	dc	i2'iobuf'
	dc	h'01'
efparm	equ	*-ofsL			parms for get eof call
	dc	h'02'
         dc    h'01'
eof	equ	*-ofsL
	dc	h'000000'		length of file.
rdparm	equ	*-ofsL			parms for read call
	dc	h'04'
	dc	h'01'
	dc	i2'sysentry'
rdlen	equ	*-ofsL
         dc    h'0000'
	dc	h'0000'
clparm	equ	*-ofsL			parms for close call
	dc	h'01'
         dc	h'00'
quitparm	equ	*-ofsL		parms for quit call
	dc	h'04'
         dc	h'00'
         dc    h'0000'
         dc	h'00'
         dc	h'0000'
iterp	equ	*-ofsL			interpreter suffix that is required
         dc    c'.SYSTEM'

* 16 bytes moved to $03F0 vectors

H257B	dc    i2'breakv'
         dc    i2'oldrst'
         dc    h'5A'			powerup byte
         jmp   oldrst                   '&' vector
         jmp   oldrst                   ctrl-y vector
         dc    h'004000'
         dc    i2'irqent'		global page interrupt vector
lc1in    lda   ramin			read/write language card RAM bank 1
         lda   ramin
         rts

* determine which system model and save in machine id (idapple)

whchrom	stz   idapple			assume standard apple //
         ldx   version                  check hardware id
         cpx   #$38                     is it apple // (autostart rom)?
         beq   H25BE			if yes
         lda   #$80
         cpx   #$06                     apple //e?
         beq   H25BC			if yes
         lda   #$40                     
         cpx   #$EA                     apple //+?
         bne   H25B6                    it not, then machine is unknown.
         ldx   HFB1E			apple /// in emulation?
         cpx   #$AD
         beq   H25BC			taken if apple //+.
         lda   #$D0                     test again for apple /// emulation
         cpx   #$8A                     because will only have 48k memory.
         bne   H25B6                    if taken, then machine is unknown.
H25B4    sec				apple /// emulation is not allowed
         rts                            because insufficient memory.
H25B6    lda   #$02			machine unknown
         sta   (dst),y
         bne   H25D9                    always.
H25BC    sta   idapple			save machine id

* check for language card ram

H25BE    jsr   lc1in			switch in language card bank 1
         lda   #$AA
         sta   $D000
         eor   $D000			if LC present, result = 0.
         bne   H25B4                    othewise, insufficient memory.
         lsr   $D000                    check lc again
         lda   #$55
         eor   $D000
         bne   H25B4                    not sufficent memory.
         lda   #$20			LC ram is available
         ora   idapple
H25D9    jmp   tst128                    jumps to page 0 routine below

* test for 128k. use page 0 for this routine

H25DC	sta   idapple			H25DC-2621 was moved to location tst128
         bpl   not128                   if already determined < 128k
         lda   #$EE
         sta   wrcardram                write to aux mem while on main zp
         sta   rdcardram                and read aux mem.
         sta   dbuf			write these locs just to test aux mem
         sta   lodintrp                 1k apart from each other.
         lda   dbuf
         cmp   #$EE
         bne   noaux
         asl   dbuf			may be sparse mem mapping so
         asl   a                        change value and see what happens.
         cmp   dbuf
         bne   noaux                    branch if not sparse mapping.
         cmp   lodintrp
         bne   H2606                    if not sparse.
noaux    sec                            no aux memory available.
         bcs   H2607
H2606    clc
H2607    sta   wrmainram                switch back to main memory
         sta   rdmainram                
         bcs   not128                   if < 128k
         lda   idapple
         ora   #$30			set id = 128k present
         sta   idapple
not128   lda   lookptr+1
         sec
         sbc   #$05
         sta   lookptr+1
         bcs   H2620
         dec   lookptr
H2620    clc
	rts

* prodos greeting splash screen

H2622    lda   spkr                     click speaker
         sta   clr80vid                 disable 80 col hardware
         sta	store80off		disable 80 col store
         jsr   setnorm                  set normal text mode
         jsr   init                     init text screen
         jsr   setvid                   reset output to screen
         jsr   setkbd                   reset input to keyboard
         cld
         jsr   home
         ldx   #$07
H263D    lda   H2009,x                  print title
         sta   vline10+16,x
         dex
         bpl   H263D
         ldx   #$1D
H2648    lda   H2011,x
         sta   vline12+5,x
         dex
         bpl   H2648
         ldx   #$0B
H2653    lda   H202F,x
         sta   vline14+14,x
         dex
         bpl   H2653
         ldx   #$26
H265E    lda   H203B,x
         sta   vline23,x
         dex
         bpl   H265E
         ldx   #$13
H2669    lda   H2062,x
         sta   vline24+10,x
         dex
         bpl   H2669
         sec
         jsr   idroutine                returns system info
         bcs   H267D			taken if not a //gs
         lda   #$80
         trb   newvideo                 video mode select
H267D    lda   spkr                     click speaker
         rts

* find all disk devices in system slots and set up address
* and device table in prodos global page. if there is a disk
* card in slot 2 then limit the # of devices in slot 5
* smartport to only 2

numdev2	dc    h'0000000000000000'	8 bytes for smartport call
driveradr dc	i2'$0000'
d2idx    dc    i1'$00'
diskins2 dc    i1'$00'			msb clear if drive in slot 2
devsrch  stz   dst
         stz   dst+1
         stz   idxl
         ldx   #$FF			init to no active devices.
         stx   numdevs                  count (-1) active devices.
         lda   #$0E			start disk // area at end of devlist.
         sta   d2idx

* check slot 2. if there is a disk card then clear the msb of diskins2. this
* will limit the # of devices in any slot 5 spartport card to 2.

         lda   #$C2
         sta   idxl+1			check slot 2
         jsr   cmpid			is there a disk in slot 2 ?
         ror   diskins2                 if so, clear msb else set it.
         lda   #$C7                     search slots from high to low
         sta   idxl+1
H26AB    jsr   cmpid
         bcs   H270C                    if no ProDOS device in this slot.
         lda   (idxl),y                 check last byte of $Cn rom (y = $ff)
         beq   diskii                   branch if 16 sector disk II.
         cmp   #$FF                     if = $FF then 13 sector disk II.
         bcs   H270C                    ignore if 13 sector boot ROM
         sta   driveradr                else assume it's an intelligent disk.
         ldy   #$07                     check for a smartport device.
         lda   (idxl),y
         bne   H26C4                    no smartport
         jmp   smartprt
H26C4    ldy   #$FE
         lda   (idxl),y			get attributes.
         and   #$03                     verify it provides read and status calls.
         cmp   #$03
         sec				assume it's an off-brand disk
         bne   H270C
         jsr   setdevid                 set up the devid byte from attributes
         clc
         php                            remember that it's not a disk //.
         lsr   a                        move # of units (0=1, 1=2) to carry.
         lda   idxl+1                   store hi entry addr (low already done)
         bne   H26E6                    branch always.
diskii	sta	devid			=0 since disk ii's have null attributes
         sec
         php                            remember it's a disk //
         lda   H2802
         sta   driveradr
         lda   H2802+1
H26E6    sta   driveradr+1
         jsr   installdev		install 1 or 2 devices from this slot.
         plp                            get back if it's a disk // (carry).
         bcc   nxtdsk2                  if not disk //.
         dex                            move the list pointer back by 2 devices
         dex
         stx   numdevs                  count (-1) active devices
         dec   d2idx                    increase the disk two index
         dec   d2idx
         ldy   d2idx
         inx                            adj since device count starts with $FF.
         lda   devlist+1,x		get entries for disk //
         sta   devlist,y                move then toward the end of the list
         lda   devlist,x                
         sta   devlist+1,y              
         dex				back to numdevs again
nxtdsk2	clc
H270C    jsr   sltrom			test for ROM in given slot and set flags
         dec   idxl+1			next lower slot.
         lda   idxl+1
         and   #$07                     have all slots been checked ?
         bne   H26AB                    no.

* perform the new device search, mapping unmounted smartport devices
* to empty slots in the device table.

         jsr   newmount

* now copy the disk // list to the end of the regular list.
* start by making the device count include disk //'s

         ldx   numdevs			current device count - 1
         lda   #$0E
         sec
         sbc   d2idx
         beq   H2747                    if there were no disk //'s then done.
         clc
         adc   numdevs                  sum of disk //'s and others.
         sta   numdevs
         inx	                        move to open space in regular list.
         ldy   #$0D                     first disk // entry.
H272F    lda   devlist,y
         pha
         lda   devlist,x                
         sta   devlist,y                
         pla
         sta   devlist,x                
         inx
         dey
         sty   d2idx			use as a temp
         cpx   d2idx
         bcc   H272F                    continue until indexes cross
H2747    ldy   #$00
         ldx   numdevs                  now change the device order so that
H274C    lda   devlist,x                the boot device will have highest
         pha                            priority.
         and   #$7F                     strip off high bit
         eor   devnum                   for comparison.
         asl   a
         bne   H275A
         pla
         iny
H275A    dex
         bpl   H274C
         ldx   numdevs                  now reverse order of search, hi to lo.
         tya                            was boot device found ?
         beq   H2777
         lda   devnum                   make boot device 1st in search order.
         sta   devlist,x
         dex
         bmi   H277E                    branch if only one device.
         dey                            is this a 2 drive device ?
         beq   H2777                    branch if not.
         eor   #$80                     make boot device, drive 2 next.
         sta   devlist,x
         dex
         bmi   H277E                    branch if only 1 device, 2 drives.
H2777    pla
         sta   devlist,x
         dex
         bpl   H2777
H277E    jsr   fndtrd                   save accumulated machine id.
         beq   H2787
         sta   machid                   machine ID byte
         rts
H2787    jmp   H25B6
stadrv   ora   devid			combine with attributes.
         ldx   numdevs                  
         inx                            put device # into device list.
         sta   devlist,x
         asl   a                        now form drive 2 device number, if any.
         rts
sltrom   bcc   H27F3			branch if disk drive

* test for clock card

         ldy   #$06
H2799    lda   (idxl),y
         cmp   dskid,y
         bne   H27BA			no clock
         dey
         dey
         bpl   H2799
         lda   idxl+1                   transfer hi slot address
         sbc   #$C1                     minus $C1 (default) to relocate
         sta   clock64                  references to clock rom.
         lda   #$4C			enable jump vector in globals.
         sta   clockv                   P8 clock vector.
         lda   idapple                  mark clock as present.
         beq   H277E
         ora   #$01
         sta   idapple			xxxxxxx1 = clock present.
         bne   H27F3                    always taken.

* test for 80 col card

H27BA    ldy   #$05
         lda   (idxl),y
         cmp   #$38
         bne   H27E4
         ldy   #$07
         lda   (idxl),y
         cmp   #$18
         bne   H27E4
         ldy   #$0B
         lda   (idxl),y
         dec   a                        must = 1
         bne   H27E4
         iny
         lda   (idxl),y
         and   #$F0                     mask off low nibble.
         cmp   #$80                     generic for 80-col card.
         bne   H27E4
         lda   idapple
         beq   H277E
         ora   #$02
         sta   idapple			xxxxxx1x = 80 col card.
         bne   H27F3                    always taken.

* test for any other rom

H27E4    ldx   #$00
         lda   (idxl)
         cmp   #$FF                     apple /// non-slot?
         beq   H2801			invalid rom
H27EC    cmp   (idxl)			look for floating bus
         bne   H2801                    no rom
         inx
         bne   H27EC
H27F3    lda   idxl+1			mark a bit in slot byte
         and   #$07                     to indicate rom present.
         tax
         lda   sltbit,x
         ora   rommap                   mark bit to flag rom present
         sta   rommap                   slot ROM bit map
H2801    rts

H2802    dc    i2'rwts'                	disk ii driver

* id bytes: evens for clock, odds for disk

dskid    dc    h'082028005803703C'

* slot bits
               	
sltbit	dc    h'0002040810204080'

fndtrd	clc
         ldy   sltbit
H2818    lda   (lookptr),y
         and   #$DF
         adc   sltbit
         sta   sltbit
         rol   sltbit
         iny
         cpy   sltbit+3
         bne   H2818
         tya
         asl   a
         asl   a
         asl   a
         asl   a
         tay
         eor   sltbit
         adc   #$0B
         bne   H283B
         lda   idapple
         rts
H283B    lda   #$00
         rts
installdev php				how many drives (carry).
         lda   idxl+1                   get index to global device table
         and   #$07                     for this slot...
         asl   a
         tay                            into y reg.
         asl   a
         asl   a                        now form device # = slot #
         asl   a                        in high nibble.
         jsr   stadrv			OR in low nibble, store in dev list.
         plp                            restore # of devices in carry.
         ror   a                        if 2 drives, then bit 7=1.
         bpl   H2853                    branch if a 1 drive device (e.g. hard drive)
         inx                            else presume that 2nd drive is present.
         sta   devlist,x                active device list.
H2853    stx   numdevs                  save updated device count.
         asl   a                        shift # of drives back into carry.
         lda   driveradr		get high address of device driver.
         sta   drivertbl1,y             device driver table 1.
         bcc   H2862                    branch if single drive.
         sta   drivertbl2,y             device driver table 2.
H2862    lda   driveradr+1
         sta   drivertbl1+1,y
         bcc   H286D
         sta   drivertbl2+1,y
H286D    rts

* query smartport status to determine # of devices
* and install up to 4 units in table if card is in slot 5
* otherwise only 2 units. this includes a patch #74

smartprt jsr   setdevid			setup the devid byte from attributes
         lda   idxl+1
         sta   driveradr+1
         lda   driveradr
         sta   pscall+1			modify operand
         clc
         adc   #$03
         sta   spvect+1
         lda   driveradr+1
         sta   spvect+2
         sta   pscall+2			modify operand
         asl   a                        convert $Cn to $n0
         asl   a
         asl   a
         asl   a
         sta   unitnum                  unit number
         stz   A4L                      force a prodos status call
         stz   buf                      dummy pointer
         stz   bloknml                  # of bytes to transfer
         stz   bloknml+1
         lda   #$10
         sta   buf+1                    dummy pointer should be <> 0

* do a prodos status call patched in from above

pscall	jsr	$0000			self modifying code
         ldy   #$FB	
         lda   (idxl),y			check device id
         and   #$02                     SCSI?
         beq   H28B1			no, no need to init Cocoon
         sta   statunit                 device = 2 for SCSI

* initialize SCSI Cocoon to build internal device tables
* and report true # of devices attached

         jsr   spvect			status of Cocoon
         dc    h'00'
         dc    i2'spcparms'             ignore any errors.
H28B1    stz   statunit                 set unit# = 0
         jsr   spvect                   call to get the device count.
         dc    h'00'                    this is a status call
         dc    i2'spcparms'
         lda   numdev2
         beq   donesp			no devices, so done.
         cmp   #$02			carry set if 2,3,4
         jsr   installdev		do the 1st and 2nd device if exists.
         lda   idxl+1
         cmp   #$C5
         bne   donesp			if not slot 5

* for slot 5, if there is a disk card in slot 2
* then only install 2 devices otherwise map
* extra devices as slot 2

         bit   diskins2			disk in slot 2 ?
         bpl   donesp                   yes - so done
         lda   numdev2
         cmp   #$03			carry set if 3,4,...
         bcc   donesp
         cmp   #$04                     carry set if 4,5,6,...
         lda   #$C2			map extra devices as slot 2
         sta   idxl+1
         jsr   installdev
         lda   #$C5
         sta   idxl+1
donesp	jmp   nxtdsk2			it's a disk device.
setdevid ldy   #$FE			check attributes byte.
H28E8    lda   (idxl),y
         lsr   a                        move hi nibble to lo nibble for
         lsr   a                        device table entries.
         lsr   a
         lsr   a
         sta   devid
         rts

* check unknown card to see if disk id = $Cn00:nn 20 nn 00 nn 03

cmpid    lda   clrrom                   switch out $C8 ROMs
         ldy   #$05
H28F6    lda   (idxl),y                 compare id bytes
         cmp   dskid,y
         sec                            set if no disk card
         bne   H2903
         dey
         dey
         bpl   H28F6			loop until all 4 id bytes match.
         clc				clear if disk card
H2903    rts

* smartport call parameters

spcparms dc    i1'$03'			# of parms
statunit dc    i1'$00'                  unit number (code for smartport stat)
         dc    i2'numdev2'
         dc    h'00'                    status code (0 = general status)

* indexes into driver table

driveridx dc    h'06'			s3, d1
	dc	h'1E'                   s7, d2
         dc	h'0E'                   s7, d1
         dc	h'1C'                   s6, d2
         dc	h'0C'                   s6, d1
         dc	h'1A'                   s5, d2
         dc	h'0A'                   s5, d1
         dc	h'14'                   s2, d2
         dc	h'04'                   s2, d1
         dc	h'12'                   s1, d2
         dc	h'02'                   s1, d1
         dc	h'18'                   s4, d2
         dc	h'08'                   s4, d1

* self modifying jmp = smartport entry address

spvect   jmp	$0000			self modifying
newmount stz   idxl
         lda   #$C7			start with slot 7 ($C700)
         sta   idxl+1
H291F    jsr   H29EB			is there a smartport device here?
         bcs   H2974            	no, next device.
         ldy   #$FF                     get smartport address.
         lda   (idxl),y
         clc
         adc   #$03			add 3 for smartport call
         sta   spvect+1
         lda   idxl+1
         sta   spvect+2
         dey
         jsr   H28E8			set up device attributes
         stz   statunit
         jsr   spvect			do a status call on smartport itself
         dc    h'00'
         dc    i2'spcparms'
         lda   numdev2			# of devices on smartport
         cmp   #$03
         bcc   H2974                    only 2 devices,skip to next one.
         inc   a                        add 1 for comparisons.
         sta   driveradr                # of devices + 1.
         lda   #$03                     start at unit #3 (non-slot 5)
         ldx   spvect+2
         cpx   #$C5                     is this slot 5?
         bne   H295B                    no, start at 3.
         bit   diskins2                 disk controller in slot 2?
         bpl   H295B                    yes, so allow remapping of s5 devices
         lda   #$05                     else start looking at unit #5

* find block devices on this smartport

H295B    cmp   driveradr                have we done all units in this slot?
         bcs   H2974                    yes, skip to next slot.
         sta   statunit                 store the unit#.
         jsr   spvect                   do status call
         dc    h'00'
         dc    i2'spcparms'
         lda   numdev2                  is this a block device?
         bmi   mount                    yes, so mount it.
H296E    lda   statunit                 go check the next unit#
         inc   a
         bra   H295B
H2974    dec   idxl+1
         lda   idxl+1
         cmp   #$C0			searched down to slot 0?
         bne   H291F                    if not.
         rts
mount    ldx   #$0C
H297F    ldy   driveridx,x
         lda   drivertbl1,y             device driver table 1
         cmp   #<nodevice
         bne   H2990
         lda   drivertbl1+1,y
         cmp   #>nodevice
         beq   H2994
H2990    dex
         bpl   H297F
         rts				ran out of space for devices, exit.

* empty slot found

H2994    lda   idxl+1
         pha
         phx
         phy
         tya				which slot is empty?
         lsr   a                        shift into slot#
         and   #$07                     now 1-7
         ora   #$C0                     now $C1-$C7
         sta   idxl+1
         jsr   H29EB			smartport interface in this slot?
         ply
         plx
         pla
         sta   idxl+1
         bcc   H2990			yes, can't use to mirror the device.
         jsr   lc1in                    write enable LC ram bank 1.
         tya                            divide index by 2
         lsr   a
         tax
         lda   statunit
         sta   spunit-1,x		store the smartport unit #
         lda   spvect+1                 and entry address.
         sta   spvectlo-1,x
         lda   spvect+2
         sta   spvecthi-1,x
         lda   romin			write protect lc ram.
         inc   numdevs
         ldx   numdevs
         tya
         lsr   a
         cmp   #$08
         bcc   nodev2			drive 2 mount
         sbc   #$08
         ora   #$08
nodev2   asl   a
         asl   a
         asl   a
         asl   a
         ora   devid			include device attributes
         sta   devlist,x                in the active device list.
         lda   #<remap_sp
         sta   drivertbl1,y             device driver table 1
         lda   #>remap_sp
         sta   drivertbl1+1,y
         bra   H296E
H29EB    jsr   cmpid			is it a disk controller?
         bcs   H29F8                    no, so return.
         sec                            assume no smartport
         ldy   #$07
         lda   (idxl),y			is it a smartport?
         bne   H29F8                    if not.
         clc				smartport found
H29F8    rts

* relocation subroutine. on entry, regs yx = address of parameter table
* with the following parameters:
*
* (1) command: 0 = zero destination range
*              1 = move data from src to dst
*              2 = hi addr ref tbl, relocate and move
*              3 = lo/hi addr ref tbl, relocate and move
*              4 = program, relocate and move
*             >4 = end of sequence of commands
* (2) destination
* (2) length
* (2) source
* (1) # of address ranges (n) to be relocated
* (n+1) list of low page addresses to be relocated
* (n+1) list of high page addresses to be relocated
* (n+1) list of offset amounts to be added to be added
*       if low and high limits have not been met
*
* on exit, carry set if error and yx = addr of error
*  with acc = $00 for table error or $FF if illegal opcode

reloc    stx   idxl			save address of control table
         sty   idxl+1
rloop    lda   (idxl)			get relocation command.
         cmp   #$05
         bcs   rlend                    taken if >= 5 then done.
         tax				move destination to page 0
         ldy   #$01                     for indirect access.
         lda   (idxl),y
         sta   dst
         iny
         lda   (idxl),y
         sta   dst+1
         iny
         lda   (idxl),y			also the length (byte count)
         sta   cnt                      of the destination area.
         iny
         lda   (idxl),y
         sta   cnt+1
         bmi   rlerr			branch if >= 32k.
         txa                            is it a request to zero destination?
         beq   zero			if yes.
         iny
         lda   (idxl),y			get source address.
         sta   src                      used for move.
         sta   cde                      used for relocation
         iny
         clc
         adc   cnt                      add length to get final address
         sta   ecde
         lda   (idxl),y
         sta   src+1
         sta   cde+1
         adc   cnt+1
         sta   ecde+1
         dex				test for 'move' command
         beq   H2AA3                    branch if move only (no relocation)
         stx   wsize			save element size (1,2,3)
         iny
         lda   (idxl),y                 get # of ranges that are valid
         sta   sgcnt                    relocation target addresses.
         tax                            separate serial range groups into tbls
H2A42    iny
         lda   (idxl),y			transfer low limits to 'limlo' table
         sta   limlo,x
         dex
         bpl   H2A42
         ldx   sgcnt			# of ranges
H2A4E    iny
         lda   (idxl),y			transfer high limits to 'limhi' table
         sta   limhi,x
         dex
         bpl   H2A4E
         ldx   sgcnt			# of ranges
H2A5A    iny
         lda   (idxl),y			transfer offsets to 'ofset' table
         sta   ofset,x
         dex
         bpl   H2A5A
         jsr   adjtbl			adj index pointer to next entry.
         ldx   wsize                    test for machine code relocation
         cpx   #$03
         beq   rlcode                   branch if program relocation
         jsr   reladr                   otherwise, relocate addresses in
H2A70    jsr   move                     tables then move to destination.
         bra   rloop                    do next table
rlend    clc
         rts
rlerr    jmp   tblerr
rlcode	jsr   rlprog			relocate machine code refs
         bra   H2A70

* fill destination range with 0's

zero	jsr   adjtbl			adj table pointer to next entry.
         lda   #$00
         ldy   cnt+1                    is it at least 1 page?
         beq   H2A94                    branch if not.
         tay
H2A89    sta   (dst),y
         iny
         bne   H2A89
         inc   dst+1			next page
         dec   cnt+1
         bne   H2A89                    if more pages to clear.
H2A94    ldy   cnt                      any bytes left to 0?
         beq   H2AA0                    if not.
         tay
H2A99    sta   (dst),y                  zero out remainder
         iny
         cpy   cnt
         bcc   H2A99
H2AA0    jmp   rloop
H2AA3    jsr   adjtbl
         bra   H2A70
adjtbl   tya				add previous table length to
         sec                            get next entry position in table
         adc   idxl
         sta   idxl
         bcc   H2AB2
         inc   idxl+1
H2AB2    rts
move	lda   src+1			is move up, down or not at all?
         cmp   dst+1
         bcc   movup
         bne   movdn
         lda   src
         cmp   dst
         bcc   movup
         bne   movdn
         rts				no move.
movup    ldy   cnt+1			calc highest page to move up
         tya                            and adj src and dst.
         clc
         adc   src+1
         sta   src+1
         tya
         clc
         adc   dst+1
         sta   dst+1
         ldy   cnt                      move partial page 1st.
         beq   H2ADE                    taken if no partial pages
H2AD6    dey
         lda   (src),y
         sta   (dst),y
         tya				end of page transfer?
         bne   H2AD6                    no
H2ADE    dec   dst+1
         dec   src+1
         dec   cnt+1			done with all pages?
         bpl   H2AD6                    no
         rts
movdn    ldy   #$00
         lda   cnt+1                    partial page move only?
         beq   H2AFC                    taken if < 1 page to move
H2AED    lda   (src),y
         sta   (dst),y
         iny
         bne   H2AED
         inc   dst+1                    next page
         inc   src+1
         dec   cnt+1                    more pages?
         bne   H2AED                    if more.
H2AFC    lda   cnt                      move partial page.
         beq   H2B09                    if no more to move
H2B00    lda   (src),y
         sta   (dst),y
         iny
         cpy   cnt
         bne   H2B00
H2B09    rts

* relocate addresses

reladr   ldy   wsize			1 or 2 byte reference
         dey
         lda   (cde),y
         jsr   adjadr			relocate reference.
         lda   wsize                    update and test code pointer.
         jsr   adjcde
         bcc   reladr			if more to do
         rts
rlprog	ldy   #$00			get next opcode
         lda   (cde),y
         jsr   oplen			determine if a 3 byte instruction.
         beq   rperr                    branch if not an opcode
         cmp   #$03
         bne   H2B30
         ldy   #$02
         jsr   adjadr			relocate address
         lda   #$03
H2B30    jsr   adjcde			update and test if done.
         bcc   rlprog                   if more to do
         rts
rperr    pla
         pla
         ldx   cde			bad code address in y,x
         ldy   cde+1
         lda   #$FF                     indicates bad opcode
         sec
         rts
tblerr   ldx   idxl			bad table address in y,x
         ldy   idxl+1
         lda   #$00                     indicates input table error
         sec
         rts
adjadr   lda   (cde),y			get page address and
         ldx   sgcnt                    test against limits.
H2B4D    cmp   limlo,x                  is it >= low?
         bcc   H2B59                    if not.
         cmp   limhi,x                  is it <= high?
         bcc   H2B5D                    branch if it is
         beq   H2B5D
H2B59    dex                            try next limit set
         bpl   H2B4D
         rts                            return w/o adjustment.
H2B5D    clc                            add offset to form relocated
         adc   ofset,x                  page address and replace
         sta   (cde),y                  old address with result.
         rts
adjcde   clc                            update code pointer
         adc   cde
         ldy   cde+1
         bcc   H2B6C                    branch if not page cross
         iny                            otherwise, update page#.
H2B6C    cpy   ecde+1                   has all code/data been processed?
         bcc   H2B72                    if not.
         cmp   ecde
H2B72    sta   cde                      save updated values.
         sty   cde+1
         rts                            return result (carry set = done).
oplen    pha				form index to tbl & which 2-bit group.
         and   #$03                     low 2 bits specify group
         tay
         pla
         lsr   a                        upper 6 bits specify byte in table
         lsr   a
         tax
         lda   opcodln,x
nxgroup  dey				is opcode len in lowest 2 bits of acc?
         bmi   H2B89                    branch if it is
         lsr   a                        shift to next group.
         lsr   a                        (if length = 0 then error)
         bne   nxgroup
H2B89    and   #$03
         rts                            if z-set then error

* relocation table contains length of each opcode in 2-bit groups

opcodln  dc    h'0928193C0A280D3C'
         dc    h'0B2A193F0A280D3C'
         dc    h'0928193F0A280D3C'
         dc    h'0928193F0A280D3C'
         dc    h'082A113F0A2A1D0C'
         dc    h'2A2A193F0A2A1D3F'
         dc    h'0A2A193F0A280D3C'
         dc    h'0A2A193F0A280D3C'

wsize    dc    i1'$00'
sgcnt    dc    i1'$00'
limlo    dc    h'0000000000000000'
limhi    dc    h'0000000000000000'
ofset    dc    h'0000000000000000'

* patch to gsos vectors so error is returned for os calls - rev note #101

patch101 php
         sei				disable interrupts
         clc
         xce                            full native mode
         LONG  I,M
	LONGA	ON
	LONGI	ON
         phb                            save DBR
         pha
         pha
         pea   $0000			length of patch
         pea   $0010			0000/0010 = 16 bytes
         pea   $3101			user id for prodos 8
         pea   $8018			attributes (locked/nospec/nocross)
         pha
         pha
         _NewHandle
         lda   $01,s			retrieve handle
         tax
         lda   $03,s
         tay
         pea   $0000			copy the code into the handle
         pea   L2C4D
         phy
         phx
         pea   $0000			length of patch = 0000/0010
         pea   $0010
         _PtrToHand
         plx                            low word of handle
         plb                            set DBR to handle's bank
         lda	|1,x			get upper 16 bits of 24 bit address
         tay                            save in y
         lda	|0,x			get low 8 bits of address
         and   #$00FF                   clear high byte
         xba                            put address in high byte
         ora   #$005C                   include JML opcode
         sta   >GSOS2                   store in gsos vectors
         clc
         adc   #$000B
         sta   >GSOS
         tya				store upper 16 bits too
         sta   >GSOS2+2
         adc   #$0000                   adj for possible page crossing
         sta   >GSOS+2
         plb				remove garbage byte from stack
         plb                            restore DBR.
         sec
         xce                            back to emulation mode
         plp
         rts

* copy of the code that goes in the handle

L2C4D	lda   $01,s
         sta   $07,s
         lda   $02,s
         sta   $08,s
         pla
         pla
         pla
         lda   #$00FF			#NoOS
         sec
         rtl
	LONGA	OFF
	LONGI	OFF			end of patch

* end of obj mli_0

ld_end	equ	*			end of mli loader
	ds	$C80-(ld_end-H2000)	pad 0's to $2C80

* object code = ram_1
*
* /RAM installer - transfer part of the driver to the aux bank
* and front part of the driver to the main bank (language card).

H2C80    ldy   #$99			move $9A bytesfrom lcsrc to lcdest.
H2C82    lda	lcsrc,y			transfer main bank portion of driver
         sta   lcdest,y                 
         dey
         cpy   #$FF
         bne	H2C82
         ldx	#<ramsrc		set up to move aux portion of driver
         stx	A1L
         dex
	stx	A2L
	ldx	#>ramsrc
         stx   A1L+1
         inx
         stx   A2L+1
         lda   #<ramdest
         sta	A4L
         lda	#>ramdest           	ramsrc to ramdest
         sta	A4L+1
	sec                      	direction = to aux bank.
         jsr   auxmove			move aux bank portion of driver.
         lda   #<lcdest			put driver address into
         sta	drivertbl2+6             slot 3, drive 2.
         lda   #>lcdest
         sta	drivertbl2+7
         inc   numdevs                  count (-1) active devices
         ldx   numdevs
         lda   #$BF                     unit num of /RAM
         sta	devlist,x
         rts				end of obj ram_1

r1_end	equ	*			end of /RAM installer
	ds	$D00-(r1_end-H2000)	pad 0's to page boundary

* object code = ram_2
* /RAM driver (main bank portion)
* origin = $FF00

ofsR2	equ	lcsrc-lcdest		offset from ram driver org

lcsrc    cld				no decimal.
         ldx   #$0B			save 13 bytes of parms
H2D03	lda	A1L,x
	sta	a1l1,x
	dex
	bpl	H2D03
         ldx   #$01
H2D0D    lda   passit,x			save xfer vectors
	sta	sp1,x
	dex
	bpl	H2D0D
         lda   A4L			get command.
         beq   stat			0 = status
         cmp   #$04                     check for command too high.
	bcs	ioerr                    if it is, i/o error
	eor	#$03
         sta   A4L			0=format, 2=read, 1=write
         beq   format
         ldy   bloknml+1		check for large block number.
         bne   ioerr                    too big.
         lda   bloknml                  block #
         bmi   ioerr                    largest block number is $7F

* at this point, control is passed to the code in the alternate 64k.
* it it used for read, write and format. after the request is completed,
* control is passed back to 'noerr'.

format	lda   #<ramdest			card entry point
         sta	passit
         lda	#>ramdest
gocard	equ	*-ofsR2			also used by 'mainwrt'
         sta	passit+1                 
	sec				direction ram -> card
         clv                            start with original zero page
         jmp   xfer                     transfer control
ioerr    lda   #$27
         bne	H2D41
         lda	#$2B			write protect error.
H2D41    sec                            flags error
         bcs   H2D47
noerr	equ	*-ofsR2
stat	lda   #$00
	clc
H2D47    php                            save status
         pha				and error code.
         ldx   #$0B                     restore 13 byes of parms
H2D4B    lda	a1l1,x
         sta   A1L,x
         dex
         bpl   H2D4B
         lda   sp1                      restore xfer parms.
         bit   $6060			addr $FF58 must = rts ($60) as in ROM
         sta   passit
         lda   sp1+1
         sta   passit+1
         pla				restore error code
         plp                            and status.
         rts
mainwrt	equ	*-ofsR2			transfer data to card.
	sta   wrcardram                write to alt 48K
         ldy   #$00
H2D6A    lda	(A1L),y			pointers set in card by 'setptr'
	sta	(A4L),y
         lda   (A2L),y
         sta   (A3L),y
         dey
         bne   H2D6A
         sta   wrmainram                write to main 48K.
         lda   #<donewrt		done writing card
         sta	passit
         lda	#>donewrt
         jmp	gocard
sp1	equ	*-ofsR2
         dc    h'0000'
a1l1	equ	*-ofsR2			13 bytes of storage

* end of obj ram_2
	
r2_end	equ	*
	ds	$D9B-(r2_end-H2000)	fill to lanirq ($FF9B see note below)

* object code = mli_3
*
* this routine handles interrupts and is coded to reach 'lreset' precisely at
* address $FFCB (ROM rts opcode) for rom switching to function.

lanirq	equ	*-ofsR2
	
H2D9B	pha                            $2D9B-2DFF moved to $FF9B-FFFF
         lda   accsav
         sta   oldacc
         pla
         sta   accsav                      
         pla				get status register from stack
         pha                            and put it back.
         and   #$10                     is it a break or interrupt?
         bne	H2DC2                   branch if break.
         lda   $D000                    get ram bankid (LC1 = $D8, LC2=$EE)
         eor   #$D8                     is the system active? ($D8)
         beq	sysactv                 branch if it is
         lda	#$FF
sysactv	sta	bankid
         sta   afbank
         lda   #>aftirq			setup return address
	pha
         lda   #<aftirq
	pha
         lda   #$04			status reg with interrupt flag set
	pha
H2DC2    lda   #>romirq			setup ROM re-entry
	pha
         lda   #<romirq
	pha
gorom	equ	*-ofsR2
         sta   romin			hits ROM rts at $FFCB

* 'lreset' address must = $FFCB for rom switch i/o to work

lreset	equ	*-ofsR2
         lda   rreset+1
         pha
         lda   rreset
         pha
         jmp   gorom
rreset	equ	*-ofsR2
         dc	I2'resetv-1'		rts to resetv
fix45	equ	*-ofsR2
         sta   p8areg                   A register savearea
         lda   oldacc
         sta   accsav
         lda   ramin			read/write RAM bank 1
         lda   ramin
         lda   afbank
         jmp   irqxit0
stypfx	equ	*-ofsR2			fix appletalk PFI bug
         sty   newpfxptr
         sty   preflag                  prefix flag
         rts
stapfx	equ	*-ofsR2
         sta   newpfxptr
         sta   preflag
         rts

* these 3 vectors hard-coded into processor

         dc    i2'nmivect'              nmi handler
         dc    i2'lreset'               reset handler
irqv	equ	*-ofsR2
	dc    i2'lanirq'		irq handler

* end of obj mli_3

* object code = mli_1
* global page

ofsG	equ	H2E00-prodos8		offset to global org

H2E00	jmp   mlient1			$2E00-2EFF moved to $BF00
jspare	equ	*-ofsG
         jmp   jspare			will be changed to point to dispatcher.
clockv   equ	*-ofsG			P8 clock vector
         rts				changed to jmp ($4C) if clock present.
         dc    i2'tclk_in'              clock routine entry address.
p8errv   equ	*-ofsG			error reporting hook.
         jmp   syserr1
sysdeath	equ	*-ofsG
         jmp   sysdeath1		system failure hook.
p8error  equ  *-ofsG			P8 error code
         dc    h'00'
drivertbl1 equ *-ofsG	device driver table 1
	dc	i2'nodevice'		slot 0 reserved
	dc	i2'nodevice'             s1, d1
	dc	i2'nodevice'             s2, d1
	dc	i2'nodevice'             s3, d1
	dc	i2'nodevice'             s4, d1
	dc	i2'nodevice'             s5, d1
	dc	i2'nodevice'             s6, d1
	dc	i2'nodevice'             s7, d1
drivertbl2 equ	*-ofsG			device driver table 2
	dc	i2'nodevice'             slot 0 reserved
	dc	i2'nodevice'             s1, d2
	dc	i2'nodevice'             s2, d2
	dc	i2'nodevice'             s3, d2
	dc	i2'nodevice'             s4, d2
	dc	i2'nodevice'             s5, d2
	dc	i2'nodevice'             s6, d2
	dc	i2'nodevice'             s7, d2
devnum	equ	*-ofsG			most recent accessed device
         dc    h'00'
numdevs  equ	*-ofsG			count (-1) active devices
	dc	h'FF'
devlist  equ	*-ofsG			active device list
         dc	h'00000000000000'       up to 14 units may be active
	dc	h'00000000000000'
         dc    h'00'
	msb	off
         dc    c'(C)APPLE  '
mlient1	equ	*-ofsG
         php
         sei
         jmp   mlicont
aftirq	equ	*-ofsG			irq returns here.
         sta   ramin			read/write RAM bank 1
         jmp   fix45			restore $45 after interrupt in LC
oldacc	equ	*-ofsG
         dc    h'00'
afbank	equ	*-ofsG
         dc	h'00'

* memory map of lower 48k. each bit represents 1 page.
* protected pages = 1, unprotected = 0

memmap   equ	*-ofsG			P8 memory bitmap
	dc	h'C000000000000000'
	dc	h'0000000000000000'
         dc    h'0000000000000001'

* table of buffer addresses for currently open files.
* these can only be changed thru the mli call setbuf.

buftbl   equ	*-ofsG
	dc	h'0000'			file #1
         dc	h'0000'                 file #2
         dc	h'0000'                 file #3
         dc	h'0000'                 file #4
         dc    h'0000'                  file #5
         dc	h'0000'                 file #6
         dc	h'0000'                 file #7
         dc	h'0000'                 file #8

* table of interrupt vectors. these can only be changed
* by the mli call allocate_interrupt. values of the registers
* at the time of the most recent interrupt are stored here along
* with the address interrupted.

inttbl   equ	*-ofsG			interrupt table
         dc    h'0000'			int #1
         dc	h'0000'                 int #2
         dc	h'0000'                 int #3
         dc	h'0000'                 int #4
p8areg   equ	*-ofsG			A register savearea
         dc    h'00'
p8xreg   equ	*-ofsG			X register savearea
	dc	h'00'
p8yreg   equ	*-ofsG			Y register savearea
	dc	h'00'
p8sreg   equ	*-ofsG			S register savearea
	dc	h'00'
p8preg   equ	*-ofsG			P register savearea
	dc	h'00'
bankid	equ	*-ofsG			bank ID byte (ROM/RAM)
	dc	h'01'
intadr   equ	*-ofsG			interrupt return address
	dc    h'0000'
p8date   equ	*-ofsG			bits 15-9=yr, 8-5=mo, 4-0=day
	dc	h'0000'
p8time   equ	*-ofsG			bits 12-8=hr, 5-0=min, low-hi format
	dc	h'0000'
flevel   equ	*-ofsG			current file level
	dc	h'00'
bubit    equ	*-ofsG			backup bit disable, setfileinfo only
	dc	h'00'
spare1	equ	*-ofsG                  used to save acc
	dc	h'00'
newpfxptr equ	*-ofsG			appletalk alternate prefix ptr
         dc	h'00'
machid   equ	*-ofsG			machine ID byte
	dc	h'00'
rommap   equ	*-ofsG			slot ROM bit map
	dc	h'00'
preflag  equ	*-ofsG			prefix active flag
	dc	h'00'
mliact   equ	*-ofsG			MLI active flag
	dc	h'00'
mliretn  equ	*-ofsG			last MLI call return address
	dc	h'0000'
mlix     equ	*-ofsG			MLI X register savearea
	dc	h'00'
mliy     equ	*-ofsG			MLI Y register savearea
	dc	h'00'

* language card bank switching routines which must reside at $BFA0 because
* workstation software patches this area

HBFA0	equ	*-ofsG
	eor   $E000			test for rom enable
         beq   L2EAA                    taken if ram enabled
         sta   romin			read ROM
         bne   L2EB5                    always
L2EAA    lda   bnkbyt2			for alternate ram
         eor   $D000                    test
         beq   L2EB5                    branch if not alternate ram
         lda   altram			else enable alt $D000
L2EB5    pla                            return code
         rti                            re-enable interrupts and return
mlicont	equ	*-ofsG
         sec
         ror   mliact                   notify interrupt routines MLI active.
         lda   $E000                    preserve language card/rom orientation
         sta   bnkbyt1                  for proper restoration when mli exits.
         lda   $D000
         sta   bnkbyt2
         lda   ramin			force ram card on
         lda   ramin                    with write allowed
         jmp   xdosmli	
irqexit	equ	*-ofsG
         lda   bankid                   determine state of ram card (ROM/RAM)
irqxit0	equ	*-ofsG
         beq   L2EE2                    branch if ram card enabled.
         bmi   L2EDF                    branch if alternate $D000 enabled.
         lsr   a                        determine if no ram card present.
         bcc   L2EE7                    branch if rom only system.
         lda   romin1                   enable rom
         bcs   L2EE7                    always taken
L2EDF    lda   altram			enable alternate $D000
L2EE2    lda   #$01                     preset bankid for rom.
         sta   bankid                   (reset if ram card interrupt)
L2EE7	lda	p8areg                  restore acc
         rti                            exit
irqent	equ	*-ofsG			this entry only used when rom
         bit	ramin                   was enabled at time of interrupt.
         bit	ramin
         jmp	irqrecev
bnkbyt1	equ	*-ofsG
         dc	h'00'
bnkbyt2	equ	*-ofsG
	dc	h'00'
	dc	h'00000000'		pad to before $BFFA
         dc	h'04'			gsos compatibility byte ($BFFA)
         dc    h'00'			pad
         dc	h'00'			reserved
         dc	h'00'			version # of running interpreter
         dc	h'00'			preserved for System Utilities
kversion equ	*-ofsG			kernal version
	dc	h'23'			represents release 2.0.3

* end of obj mli_1

* object code = tclock_0
* Thunderclock driver
* hard coded for slot 1

* $2F00-2F7C moved to $D742

ofsT	equ	tclock_0-tclk_in	offset to Thunderclock org

tclock_0	ldx   clkslt		clock slot = $C1.
         lda   clkmode,x                save current mode
         pha
         lda   #$A3                     send numeric mode byte to Thunderclock
         jsr	wttcp
clkslt	equ	*-ofsT+2		points to $C1.
         jsr	rdtcp			read month, day of week, day of month
         clc                            and time into input buffer.
         ldx   #$04			index for 5 values.
	ldy	#$0C                    read minutes 1st, month last.
H2F14	lda	inbuf,y                 convert values to binary.
	and	#$07                    no value > 5 decimal.
	sta	pcl			'tens' place value
         asl   a                        multiply by 10
         asl   a
         adc   pcl
         asl   a
         adc   inbuf+1,y		add to ascii 'ones' place
         sec                            and subtract out the ascii
         sbc   #$B0
         sta	pcl,x                   save converted value.
         dey                            index to next lowest value
         dey
         dey
         dex                            are there more values?
         bpl   H2F14                    if yes.
         tay                            contains month
         lsr   a
         ror   a
         ror   a
         ror   a                        high bit of month held in carry
         ora   A1L
         sta   p8date                   save low value of date.
         php                            save high bit of month.
         and   #$1F                     isolate day.
         adc	tdays-1,y               (y = month)
	bcc	H2F42			branch if not Sept 13 thru 30th
	adc	#$03                    adj for mod 7 when day > 256
H2F42	sec
H2F43	sbc	#$07
	bcs	H2F43			loop until < 0.
	adc	#$07                    make it in the range of 0-6.
         sbc   pch                      the delta provides years offset.
         bcs   H2F4F                    branch if positive
         adc   #$07                     else make it positive again.
H2F4F	tay                            
         lda   yradj,y                  look up year
         plp                            and combine it with hi bit of month
         rol   a
         sta   p8date+1                 P8 date
         lda   A1L+1			hour
         sta   p8time+1                 P8 time
         lda   A2L			minute
         sta   p8time
         pla                            restore previous mode.
         ldx   clkslt			clock slot = $C1
         sta   clkmode,x
H2F69	rts

* this table contains entries for the cumulative # of days in a year,
* one entry for each month. the values are modulo 256.

tdays	equ	*-ofsT
         dc    h'00'	January
         dc	h'1F'                    February
         dc	h'3B'                    March
         dc	h'5A'                    April
         dc	h'78'                    May
         dc	h'97'                    June
         dc	h'B5'                    July
         dc	h'D3'                    August
         dc    h'F2'                     September
         dc	h'14'                    October (MOD 256)
         dc	h'33'                    November
         dc	h'51'                    December

* the following table is used to look up the current year, based on
* the current month, day and day of week. The 1st entry corresponds
* to the year in which January 1st falls on a Monday. The 2nd entry
* is the year which January 1st is Sunday, and so on backwards thru
* the days of the week.

yradj	equ	*-ofsT
	dc	h'60'	Monday
         dc	h'5F'                    Sunday
         dc	h'5E'                    Saturday
         dc	h'5D'                    Friday
         dc    h'62'                     Thursday
         dc	h'61'                    Wednesday
         dc	h'60'                    Tuesday
tclk_end	equ	*		 end of obj tclock_0.
	dc	h'000000'		 pad

* object code = cclock_0
* Cortland clock driver
* $2F80-$2FFC moved to $D742

ofsC	equ	cclock_0-tclk_in	offset to Cortland clock org

cclock_0 SHORT I,M			8 bit mode.
         lda   statereg                 state register.
         sta   savestate		save for restore after tool call.
         and   #$CF                     clear the read/write aux memory bits.
         sta   statereg                 make it real
         clc                            set e = 0 to set native mode
         xce		
         LONG  I,M                      16 bit mode.
         lda   #$0000                   zero out result space.
         pha                            push 4 words for hex time result
         pha
         pha
         pha
         _ReadTimeHex
         SHORT M			back to 8 bit to get results from stack
         lda   savestate		restore state register
         sta   statereg
         pla				pull off seconds and ignore
         pla
         sta   p8time                   minutes
         pla
         sta   p8time+1                 hours
         pla                            year
H2FB1    cmp   #100			out of range?
         bcc   H2FB9                    no, go ahead and store
         sbc   #$64                     else put back in range.
         bra   H2FB1                    try again
H2FB9    sta   p8date+1                 year
         pla
         inc   a                        increment day for Prodos 8 format.
         sta   p8date                   day
         pla                            month
         inc   a                        increment month for Prodos 8 format.
         asl   a                        shift month as it sits in between
         asl   a                        the year and day values.
         asl   a
         asl   a
         asl   a
         ora   p8date			put all but the top bit of month
         sta   p8date                   value in the day byte.
         rol   p8date+1                 put hi bit of month in low bit of year
         pla                            pull of unused byte
         pla                            pull off day of week. stack now clean.
         sec                            go back to emulation mode
         xce                            to continue with Prodos 8
         rts
savestate equ	*-ofsC
         dc    h'00'			state of the state register
         dc    c'JIMJAYKERRY'
	dc	h'26'			ampersand (Orca assembler doesn't like)
	dc	c'MIKE'
         dc    h'0000000000000000'	pad 0's until length
         dc    h'0000000000000000'      of driver = 125 bytes.
         dc    h'000000000000'
cclk_end equ	*			end of obj cclock_0.
	dc	h'000000'		pad to page boundary
	LONGI	OFF

* object code = mli_2
* xdos mli system call processor

ofsX	equ	xdosobj-xdosorg		offset to xdos org

xdosmli	equ	*-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   a                        and hash it to a range of 0-$1F
         lsr   a
         lsr   a
         lsr   a
         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   a                        carry set if bfm or dev mgr
         bpl   godevmgr
         bcs   gobfmgr
         lsr   a			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   a			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   a				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 equ	*-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	equ	*-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 equ	*-ofsX
         jsr   p8errv                   P8 error vector
dmgr	equ	*-ofsX			interrupts must always be off.
         lda   unitnum			get device # and
         and   #$F0                     strip misc lower nibble
         sta   unitnum			then save it.
         lsr   a                        use as index to device table
         lsr   a
         lsr   a
         tax
         lda   drivertbl1,x		fetch driver address
         sta   goadr
         lda   drivertbl1+1,x
         sta   goadr+1
gocmd	equ	*-ofsX
         jmp   (goadr)			goto driver (or error if no driver)

* ProDOS interrupt manager

intmgr	equ	*-ofsX
         sta   A4L			interrupt command
         lsr   a                        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   a
         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   a
         tax
         lda   #$00			now clear it
         sta   inttbl-2,x
         sta   inttbl-1,x
         clc
         rts
irqrecev equ	*-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   clrrom                   re-enable i/o card.
irqdev	equ	*-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	equ	*-ofsX
         dc    h'00'			0 = old roms. 1 = new roms.
irqcount equ	*-ofsX
         dc	h'00'                   # of unclaimed interrupts.
svstack	equ	*-ofsX			temporary save area from stack
	dc	h'0000000000000000'
         dc    h'0000000000000000'
svzerop	equ	*-ofsX			temporary save area for zero page
         dc    h'000000000000'	
goint1	equ	*-ofsX
         jmp   (inttbl)                 interrupt routine 1
goint2	equ	*-ofsX
         jmp   (inttbl+2)               interrupt routine 2
goint3	equ	*-ofsX
         jmp   (inttbl+4)               interrupt routine 3
goint4	equ	*-ofsX
         jmp   (inttbl+6)               interrupt routine 4
syserr1	equ	*-ofsX
         sta   p8error                  P8 error code
         plx
         plx				pop 1 level of return
         sec
         rts
sysdeath1 equ	*-ofsX
         tax				death error code.
         sta   clr80vid                 disable 80 col hardware.
         lda   txtset                   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   txtpage1                 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	equ	*-ofsX
         lda   disptch,x		translate into command address.
         asl   a                        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	equ	*-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	equ	*-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 equ	*-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 equ	*-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	equ	*-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   a
         lsr   a
         ror   a
         ror   a
         ror   a			multiply by 32.
         sta   fcbptr                   used as an index to fcb
         tay
         pla                            restore ref# in acc
         cmp   fcbbuf,y
         bne   errnoref
fndfcbuf equ	*-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	equ	*-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	equ	*-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	equ	*-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

* create file

create	equ	*-ofsX
         jsr   lookfile			check for duplicate, get free entry
         bcs   tstfnf                   error code may be 'file not found'
         lda   #$47                     name already exists
crerr1	sec
         rts
tstfnf	cmp   #$46                     'file not found' is ok
         bne   crerr1                   otherwise exit with error.
         ldy   #$07                     test for tree or directory file,
         lda   (A3L),y                  no other kinds are legal.
         cmp   #$04                     is it seed, sapling or tree?
         bcc   tstdspc                  branch if it is
         cmp   #$0D
         bne   ctyperr                  report type error if not directory.
tstdspc	lda   devnum                   	make sure destination device
         jsr   twrprot1                 is not write protected.
         bcs   H351D
         lda   nofree			is there space in directory to
         beq   xtndir                   add this file? branch if not
         jmp   creat1                   otherwise, go create file.
ctyperr	lda   #$4B			filetype error
         sec
H351D    rts
xtndir	lda   own_blk			before extending directory,
         ora   own_blk+1                make sure it's a subdirectory.
         bne   H352A
         lda   #$49                     otherwise, directory full error
         sec
         rts
H352A    lda   bloknml			preserve disk address of current (last)
         pha				directory link, before allocating an
         lda   bloknml+1                extended block.
         pha
         jsr   alc1blk                  allocate a block for extending directory
         plx
         stx   bloknml+1                restore block addr of dir info in gbuf
         plx
         stx   bloknml
         bcs   H351D			unable to allocate.
         sta   gbuf+2                   save block address in y,a to
         sty   gbuf+3                   current directory.
         jsr   wrtgbuf			update directory block with new link.
         bcs   H351D                    if error
         ldx   #$01
swpbloks lda   bloknml,x                prepare new directory block
         sta   gbuf,x                   using current block as back link
         lda   gbuf+2,x
         sta   bloknml,x                and save new block as next to be written
         dex
         bpl   swpbloks
         inx
         txa				x and a = 0
clrdir   sta   gbuf+2,x
         sta   gbuf+$100,x
         inx
         bne   clrdir
         jsr   wrtgbuf			write prepared directory extension.
         bcs   H351D                    if error
         lda   own_blk
         ldx   own_blk+1
         jsr   rdblk			read in parent directory block
         ldx   own_ent                  and calc entry address.
         lda   #>gbuf
         sta   zpt+1
         lda   #$04
ocalc    clc
         dex                            has entry address been calulated?
         beq   H3584                    if yes.
         adc   own_len                  next entry address
         bcc   ocalc
         inc   zpt+1                    entry must be in 2nd 256 bytes of block
         bcs   ocalc			always taken.
H3584    sta   zpt
         ldy   #$13                     index to block count
H3588    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   H3588                    branch if not.
         jsr   wrtgbuf                  go update parent.
         bcs   crerr2
         jmp   create
crerr2   rts                            return and report errors
creat1	equ	*-ofsX
         ldx   #$00                     zero out gbuf
H35A0    stz   gbuf,x
         stz   gbuf+$100,x              and data block of file.
         inx
         bne   H35A0
         ldy   #$0B                     move user specified date/time
cmvtime	lda   (A3L),y                  	to directory.
         sta   d_filid,y
         txa                            if all 4 bytes of date/time = 0
         ora   (A3L),y                  then use built-in date/time.
         tax
         dey
         cpy   #$07
         bne   cmvtime
         txa				does user want default time?
         bne   cmvname                  if not.
         ldx   #$03
mvdftime lda   p8date,x                 move current default date/time
         sta   d_credt,x
         dex
         bpl   mvdftime
cmvname	lda   (A3L),y			y = index to file kind.
         cmp   #$04
         lda   #$10			assume tree type
         bcc   csvfkind
         lda   #$D0                     it's directory.
csvfkind ldx   namptr                   index to local name of pathname.
         ora   pathbuf,x                combine file kind with name length.
         sta   d_stor                   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
crname	lda   pathbuf,x                	move local name as filename
         sta   d_stor,y
         dex
         dey
         bne   crname
         ldy   #$03			index to 'access' parameter
         lda   (A3L),y
         sta   d_attr
         iny				also move 'file identification'
         lda   (A3L),y
         sta   d_filid
cmvauxid iny				move auxillary identification bytes
         lda   (A3L),y
         sta   d_auxid-5,y
         cpy   #$06
         bne   cmvauxid
         lda   xdosver			save current xdos version #
         sta   d_sosver
         lda   compat                   and backward compatibility #
         sta   d_comp
         lda   #$01                     usage is always 1 block
         sta   d_usage
         lda   d_head			place back pointer to header block
         sta   d_dhdr
         lda   d_head+1
         sta   d_dhdr+1
         lda   d_stor			storage type.
         and   #$E0                     is it a directory?
         beq   cralcblk                 branch if seed file.
         ldx   #$1E                     move header to data block
cmvheadr lda   d_stor,x
         sta   gbuf+4,x
         dex
         bpl   cmvheadr
         eor   #$30
         sta   gbuf+4			make it a directory header mark.
         ldx   #$07                     overwrite password area and other
cmvpass	lda   pass,x                  	header info.
         sta   gbuf+20,x
         lda   xdosver,x
         sta   gbuf+32,x
         dex
         bpl   cmvpass
         ldx   #$02			and include info about parent directory
         stx   d_eof+1
cmvparnt lda   d_entblk,x
         sta   gbuf+39,x
         dex
         bpl   cmvparnt
         lda   h_entln                  lastly, the length of parent's
         sta   gbuf+42			directory entries.
cralcblk jsr   alc1blk                  get address of file's data block
         bcs   crerr3
         sta   d_frst
         sty   d_frst+1
         sta   bloknml
         sty   bloknml+1
         jsr   wrtgbuf			go write data block of file
         bcs   crerr3
         inc   h_fcnt                   add 1 to total # of files in this dir
         bne   credone
         inc   h_fcnt+1
credone	jsr   drevise			go revise directories with new file
         bcs   crerr3
         jmp   upbmap                   lastly, update volume bitmap
entcalc	equ	*-ofsX
         lda   #>gbuf			set high address of dir entry
         sta   zpt+1                    index pointer.
         lda   #$04                     calc address of entry based
         ldx   d_entnum                 on the entry #.
H3689    clc
H368A    dex                            addr = gbuf + ((d_entnum-1) * h_entln)
         beq   H3696                    branch with carry clear = no errors.
         adc   h_entln
         bcc   H368A
         inc   zpt+1                    inc hi address.
         bcs   H3689			always.
H3696    sta   zpt                      newly calculated low address.
crerr3   rts                            carry set if error.
drevise	equ	*-ofsX
         lda   p8date
         beq   H36A9                    if no clock, then don't mod date/time.
         ldx   #$03
modtime	lda   p8date,x                 	move last modification date/time
         sta   d_moddt,x                to entry being updated.
         dex
         bpl   modtime
drevise1 equ	*-ofsX
H36A9    lda   d_attr			mark entry as backupable
         ora   bkbitflg                 (bit 5 = backup needed)
         sta   d_attr
         lda   d_dev                    get device # of directory
         sta   devnum                   to be revised
         lda   d_entblk                 and address of direcotry block.
         ldx   d_entblk+1
         jsr   rdblk                    read block into general purpose buffer
         bcs   crerr3
         jsr   entcalc                  fix up ptr to entry location within gbuf.
         ldy   h_entln                  now move 'd.' info to directory.
         dey
H36CA    lda   d_stor,y
         sta   (zpt),y
         dey
         bpl   H36CA
         lda   d_head			is the entry block same as
         cmp   bloknml                  the entry's header block?
         bne   H36E0                    if no, go save entry block
         lda   d_head+1                 then maybe, so test high addresses.
         cmp   bloknml+1
         beq   uphead                   branch if they are the same block.
H36E0    jsr   wrtgbuf                  go write updated directory block.
         bcs   crerr3
         lda   d_head                   get address of header block and
         ldx   d_head+1
         jsr   rdblk                    go read in header block to modify.
         bcs   crerr3
uphead	ldy   #$01			update current # of files in this dir.
H36F2    lda   h_fcnt,y
         sta   gbuf+37,y                (current entry count)
         dey
         bpl   H36F2
         lda   h_attr                   also update header's attributes.
         sta   gbuf+34
         jsr   wrtgbuf                  go write updated header
         bcs   H375A
ripple	lda   gbuf+4			test for 'root' directory because
         and   #$F0                     if it is, then directory revision
         eor   #$F0                     is complete (leaves carry clear).
         beq   H3770                    branch if done.
         lda   gbuf+41			get entry #
         sta   d_entnum
         lda   gbuf+42                  and the length of ertries in that dir
         sta   h_entln
         lda   gbuf+39                  get addr of parent entry's dir block
         ldx   gbuf+40
         jsr   rdblk                    read it
         bcs   H375A
         jsr   entcalc                  get indirect ptr to parent entry in gbuf
         lda   p8date			don't touch mod
         beq   H373B                    if no clock...
         ldx   #$03                     update the modification date & time
         ldy   #$24                     for this entry too
H3732    lda   p8date,x
         sta   (zpt),y
         dey
         dex
         bpl   H3732
H373B    jsr   wrtgbuf                  write updated entry back to disk.
         bcs   H375A                    if error.
         ldy   #$25                     compare current block # to this
         lda   (zpt),y                  entry's header block.
         iny
         cmp   bloknml                  are low addresses the same?
         sta   bloknml
         bne   H3751                    branch if entry doesn't reside in same
         lda   (zpt),y                  block as header.
         cmp   bloknml+1                are high address the same?
         beq   ripple                   they are the same, continue to root dir.
H3751    lda   (zpt),y                  not same so read in this dir's header.
         sta   bloknml+1
         jsr   rdgbuf
         bcc   ripple			continue if read was good
H375A    rts
tsterr   lda   #$52			not tree or dir, unrecognized type
         sec
         rts
tstsos	equ	*-ofsX			test if xdos disk.
         lda   gbuf                     pointer to previous dir block
         ora   gbuf+1                   must be null
         bne   tsterr
         lda   gbuf+4                   test for header
         and   #$E0
         cmp   #$E0
         bne   tsterr
H3770    clc                            no error
         rts
findfile equ	*-ofsX
         jsr   lookfile			see if file exists
         bcs   nofind
moventry equ	*-ofsX
         ldy   h_entln
H377A    lda   (zpt),y                  move entry into storage
         sta   d_stor,y
         dey
         bpl   H377A
         lda   #$00			no errors
nofind   rts
lookfile equ	*-ofsX
         jsr   preproot			go find volume
         bcs   fnderr
         bne   L37C5			branch if more than root
         lda   #>gbuf                   otherwise, report a bad path error
         sta   zpt+1                    (but 1st create a phantom entry
         lda   #$04                     for open)
         sta   zpt
         ldy   #$1F			move in id and date info
phantm1  lda   (zpt),y
         sta   d_stor,y
         dey
         cpy   #$17
         bne   phantm1
phantm2  lda   rootstuf-$10,y
         sta   d_stor,y
         dey
         cpy   #$0F
         bne   phantm2
         lda   #$D0			fake directory file
         sta   d_stor
         lda   gbuf+2                   check forward link.
         ora   gbuf+3                   if non-zero, assume full sized directory
         bne   H37C2                    else assume it's the slot 3 /RAM volume
         lda   #$02                     so reset eof and blocks_used fields
         sta   d_eof+1
         lda   #$01
         sta   d_usage
H37C2    lda   #$40			bad path (carry set)
         rts
lookfil0 equ	*-ofsX
L37C5    stz   nofree			reset free entry indicator.
         sec                            dir to be searched has header in this block.
L37C9    stz   totent                   reset entry counter.
         jsr   looknam			look for name pointed to by pnptr.
         bcc   namfound			if name was found.
         lda   entcntl                  have we looked at all of the
         sbc   totent                   entries in this directory?
         bcc   L37E2                    maybe, check hi count.
         bne   L37EB                    no, read next directory block.
         cmp   entcnth                  has the last entry been looked at?
         beq   errfnf                   yes, give 'file not found' error
         bne   L37EB			or branch always.
L37E2    dec   entcnth                  should be at least one
         bpl   L37EB                    so this should be branch always...
errdir   lda   #$51                     directory error
fnderr   sec
         rts
L37EB    sta   entcntl			keep a running count.
         lda   #>gbuf                   reset indirect pointer
         sta   zpt+1
         lda   gbuf+2                   get link to next dir block
         bne   L37FC                    (if there is one).
         cmp   gbuf+3                   are both zero, i.e. no link? if so,
         beq   errdir                   then not all entries were acct'd for.
L37FC    ldx   gbuf+3                   acc has value for block# (low).
         jsr   rdblk                    go read the next linked directory.
         bcc   L37C9                    if no error.
         rts                            return error in acc.
errfnf   lda   nofree			was any free entry found?
         bne   fnf0
         lda   gbuf+2                   test link
         bne   L3814
         cmp   gbuf+3                   if both are 0 then give up.
         beq   fnf0                     report 'not found'.
L3814    sta   d_entblk
         lda   gbuf+3
         sta   d_entblk+1               assume 1st entry of next block
         lda   #$01                     is free for use.
         sta   d_entnum                 mark as valid (for create)
         sta   nofree
fnf0     jsr   nxtpnam1			'file not found' or 'path not found'?
errpath1 sec                            if non-zero then 'path not found'
         beq   fnf1
         lda   #$44			path not found
         rts
fnf1     lda   #$46                     file not found
         rts
namfound jsr   nxtpname			adj index to next name in path.
         beq   filfound                    branch if that was the last name.
         ldy   #$00                     be sure this is a directory entry.
         lda   (zpt),y                  high nibble will tell.
         and   #$F0
         cmp   #$D0                     is it a subdirectory?
         bne   errpath1                 error if not.
         ldy   #$11                     get address of 1st subdirectory block
         lda   (zpt),y
         sta   bloknml                  (no checking done for a valid block#)
         iny
         sta   d_head                   save as file's header block too
         lda   (zpt),y
         sta   bloknml+1
         sta   d_head+1
         jsr   rdgbuf                   read subdirectory into gbuf.
         bcs   fnderr1                  if error.
         lda   gbuf+37                  get the # of files contained in this
         sta   entcntl                  directory.
         lda   gbuf+38
         sta   entcnth
         lda   gbuf+20                  make sure password is disabled
         ldx   #$00
         sec
         rol   a
L3869    bcc   L386C
         inx
L386C    asl   a
         bne   L3869
         cpx   #$05			is password disabled?
         beq   movhead
         lda   #$4A                     directory is not compatible
fnderr1  sec
         rts
movhead  jsr   movhed0			move directory info.
         jmp   lookfil0                 do next local pathname.
movhed0	equ	*-ofsX
         ldx   #$0A			move this directory info
L387F    lda   gbuf+28,x
         sta   h_credt,x
         dex
         bpl   L387F
         lda   gbuf+4			if this is root, then nothing to do
         and   #$F0
         eor   #$F0                     test header type.
         beq   L389C                    branch if root
         ldx   #$03                     otherwise, save owner info about
L3893    lda   gbuf+39,x                this header.
         sta   own_blk,x
         dex
         bpl   L3893
L389C    rts
entadr	equ	*-ofsX
filfound lda   h_maxent			figure out which entry # this is
         sec
         sbc   cntent                   max entries - count entries + 1
         adc   #$00                     = entry # (carry was set)
         sta   d_entnum
         lda   bloknml                  and indicate block # of this directory
         sta   d_entblk
         lda   bloknml+1
         sta   d_entblk+1
         clc
         rts
looknam	equ	*-ofsX			reset count of files per block
         lda   h_maxent
         sta   cntent
         lda   #>gbuf
         sta   zpt+1
         lda   #$04
L38C1    sta   zpt                      reset indirect pointer to gbuf
         bcs   L38F8			branch if this block contains a header
         ldy   #$00
         lda   (zpt),y                  get length of name in directory.
         bne   isname                   branch if there is a name.
         lda   nofree			test if a free entry has been declared.
         bne   L38F8                    yes, inc to next entry.
         jsr   entadr                   set address for current entry.
         inc   nofree			indicate a free spot has been found.
         bne   L38F8                    always.
isname   and   #$0F                     strip byte (is checked by 'filfound')
         inc   totent			inc count of valid files found.
         sta   namcnt                   save name length as counter.
         ldx   namptr                   get index to current path.
         cmp   pathbuf,x                are both names the same length?
         bne   L38F8                    no, inc to next entry.
cmpname  inx                            (first) next letter index
         iny
         lda   (zpt),y                  compare names letter by letter
         cmp   pathbuf,x
         bne   L38F8
         dec   namcnt                   all letters compared?
         bne   cmpname                  no, continue.
         clc                            a match is found.
noname   rts
L38F8    dec   cntent			checked all entries in this block?
         sec
         beq   noname                   yes, no name match.
         lda   h_entln                  add entry length to current pointer
         clc
         adc   zpt
         bcc   L38C1                    branch if still in 1st page.
         inc   zpt+1                    look on 2nd page.
         clc                            carry should always be clear before
         bcc   L38C1                    looking at next.
preproot equ	*-ofsX
         jsr   findvol			search vcb's and dev's for spec'd volume
         bcs   novolume
         lda   #$00			zero out directory temps
         ldy   #$42
L3914    sta   own_blk,y                and owner info
         dey
         bpl   L3914
         lda   devnum                   setup device # for this directory
         sta   d_dev
         jsr   movhed0                  setup other header info from directory
         ldy   #$01                     in gbuf and clean up misc info.
         ldx   vcbptr
         inx
L3929    lda   vcbbuf+18,x              misc info includes
         sta   h_tblk,y                 total # of blocks,
         lda   vcbbuf+26,x              the address of the 1st bitmap,
         sta   h_bmap,y
         lda	|bloknml,y		directory's disk address,
         sta   d_head,y
         lda   h_fcnt,y                 and setting up a counter for the # of
         sta   entcntl,y                files in this directory.
         dex
         dey
         bpl   L3929
nxtpname equ	*-ofsX
         jsr   nxtpnam1			get new namptr in y and namlen in acc.
         sty   namptr                   save new pathname pointer.
         rts                            (status reg according to accumulator)
nxtpnam1 equ	*-ofsX
         ldy   namptr                   inc pathname pointer to next name
         lda   pathbuf,y                in the path.
         sec
         adc   namptr                   if this addition results in zero,
         tay                            then prefixed directory has been moved
         bne   L395F                    to another device. branch if not.
         lda   devnum                   revise devnum for prefixed directory
         sta   p_dev
L395F    lda   pathbuf,y                test for end of name.
         clc                            no errors
novolume rts
findvol	 equ	*-ofsX
         lda   #$00
         ldy   preflag                  use prefix volume name to look up vcb.
         bit   prfxflg                  is this a prefixed path?
         bpl   L396F                    branch if it is
         tay                            set ptr to volume name
L396F    sty   vnptr                    and save.
         sta   devnum                   zero out dev# until vcb located.
L3975    pha                            acc now used as vcb lookup index.
         tax                            index pointer to x.
         lda   vcbbuf,x                 get vcb volume name length.
         bne   L3987                    branch if claimed vcb to be tested.
L397C    ldy   vnptr                    restore pointer to requested vol name.
         pla                            now adj vcb index to next vcb entry.
         clc
         adc   #$20
         bcc   L3975                    branch if more vcb's to check
         bcs   L39D4                    otherwise go look for unlogged volumes.
L3987    sta   namcnt                   save length of vol name to be compared.
L398A    cmp   pathbuf,y                is it the same as requested vol name?
         bne   L397C                    branch if not
         inx
         iny                            next character
         lda   vcbbuf,x
         dec   namcnt                   last character?
         bpl   L398A                    if not.
         plx                            restore pointer to matching vcb.
         stx   vcbptr                   save it for future reference.
         lda   vcbbuf+16,x              get it's device #
         sta   devnum                   and save it.
         stz   bloknml+1                assume prefix is not used and
         lda   #$02                     that root directory is to be used.
         sta   bloknml
         lda   vnptr                    = 0 if no prefix.
L39AC    tay                            if prefix then find ptr to prefixed
         sta   namptr                   dir name. save path ptr.
         beq   L39C2                    branch if no prefix.
         sec
         adc   pathbuf,y                inc to next dir in prefix path.
         bcc   L39AC                    branch if another dir in prefix.
         lda   p_blok                   volume verification will occur at
         sta   bloknml                  subdirectory level.
         lda   p_blok+1
         sta   bloknml+1

* verify volume name

L39C2    jsr   rdgbuf			read in directory (or prefix dir)
         bcs   L39CC                    if error then look on other devices.
         jsr   cmppnam			compare dir name with path name.
         bcc   L39F0                    if they match, stop looking.
L39CC    ldx   vcbptr                   check if current (matched) vcb is active
         lda   vcbbuf+17,x		i.e. does it have open files?
         bmi   L39ED                    report not found if active.
L39D4    lda   vnptr                    make path ptr same as volume ptr
         sta   namptr
         jsr   mvdevnums                copy all device #'s to be examined.
         lda   devnum                   log current device 1st before searching
         bne   L39F1                    others.
L39E2    ldx   numdevs                  scan look list for devices we need
L39E5    lda   loklst,x                 to search for the requested volume.
         bne   L39F4                    branch if we've a device to look at.
         dex
         bpl   L39E5                    look at next one.
L39ED    lda   #$45                     no mounted volume
         sec                            error
L39F0    rts
L39F1    ldx   numdevs                  now remove the device from the list
L39F4    cmp   loklst,x                 of prospective devices.
         beq   L39FE                    branch if match.
         dex                            look until found.
         bpl   L39F4                    always taken (usually) unless
         bmi   L39ED                    if dev was removed from devlst (/RAM).
L39FE    sta   devnum                   preserve device to be checked next.
         stz   loklst,x                 mark this one as tested.
         jsr   fnddvcb                  find vcb that claims this dev (if any).
         bcs   L3A29                    branch if vcb full.
         ldx   vcbptr                   did fndvcb find it or return free vcb?
         lda   vcbbuf,x
         beq   L3A16			if free vcb.
         lda   vcbbuf+17,x              is this volume active?
         bmi   L39E2                    if so, no need to re-log.
L3A16    lda   #$02                     go read root dir into gbuf
         ldx   #$00
         jsr   rdblk
         bcs   L39E2                    ignore if unable to read.
         jsr   logvcb			go log in volume name.
         bcs   L39E2                    look at next if non-xdos disk mounted.
         jsr   cmppnam                  is this the volume ?
         bcs   L39E2                    if not
L3A29    rts
mvdevnums equ	*-ofsX
         ldx   numdevs                  copy all dev #'s to be checked.
L3A2D    lda   devlist,x                active device list.
         and   #$F0                     strip device type info.
         sta   loklst,x                 copy them to a temp workspace
         dex
         bpl   L3A2D
         ldx   numdevs
         rts
fnddvcb	equ	*-ofsX			look for vcb with this device#
         lda   #$00
         ldy   #$FF
L3A40    tax				new index to next vcb
         lda   vcbbuf+16,x              check all devnums
         cmp   devnum			is this the vcb?
         bne   L3A4E                    if not
         stx   vcbptr
         clc                            indicates found
         rts
L3A4E    lda   vcbbuf,x			is this a free vcb?
         bne   L3A57                    if not
         iny
         stx   vcbptr
L3A57    txa
         clc				inc index to next vcb
         adc   #$20
         bne   L3A40
         tya                            any free vcb's available?
         bpl   L3A79                    yes
         lda   #$00                     look for an entry to kick out
L3A62    tax
         lda   vcbbuf+17,x              any open files?
         bpl   L3A70                    no, kick this one out.
         txa                            next vcb
         clc
         adc   #$20                     (vcb entry size)
         bne   L3A62
         beq   L3A7A                    all vcb entries have open files
L3A70    stx   vcbptr                   save entry index.
         stz   vcbbuf,x                 free this entry
         stz   vcbbuf+16,x
L3A79    clc                            no error.
L3A7A    lda   #$55                     # vcb full error
         rts
cmppnam	equ	*-ofsX
         ldx   #$00                     index to directory name.
         ldy   namptr                   index to pathname.
         lda   gbuf+4                   get dir name length and type.
         cmp   #$E0			is it a directory?
         bcc   L3A90                    if not.
         and   #$0F                     isolate name length and
         sta   namcnt                   save as a counter.
         bne   L3A95                    branch if valid length.
L3A90    sec                            indicate not found
         rts
L3A92    lda   gbuf+4,x                 next char
L3A95    cmp   pathbuf,y
         bne   L3A90                    if not the same.
         inx                            check next char
         iny
         dec   namcnt
         bpl   L3A92                    if more to compare.
         clc                            match found
         rts
logvcb	equ	*-ofsX                   
         ldx   vcbptr                   previously logged in volume?
         lda   vcbbuf,x                 (acc = 0?)
         beq   L3AB0                    no, go prepare vcb.
         jsr   cmpvcb                   does vcb match vol read?
         bcc   L3B05                    yes, do not disturb.
logvcb1	equ	*-ofsX
L3AB0    ldy   #$1F                     zero out vcb entry
L3AB2    stz   vcbbuf,x
         inx
         dey
         bpl   L3AB2
         jsr   tstsos			make sure it's an xdos disk
         bcs   L3B05			if not, return carry set.
         jsr   tstdupvol		does a duplicate with open files
         bcs   L3B04                    already exist? branch if yes.
         lda   gbuf+4                   move volume name to vcb.
         and   #$0F                     strip root marker
         tay
         pha
         ora   vcbptr
         tax
L3ACE    lda   gbuf+4,y
         sta   vcbbuf,x
         dex
         dey
         bne   L3ACE
         pla                            get length again
         sta   vcbbuf,x                 and save.
         lda   devnum                   last device used.
         sta   vcbbuf+16,x              save device # and
         lda   gbuf+41                  total # of blocks on this unit.
         sta   vcbbuf+18,x
         lda   gbuf+42
         sta   vcbbuf+19,x
         lda   bloknml                  save address of root directory.
         sta   vcbbuf+22,x
         lda   bloknml+1
         sta   vcbbuf+23,x
         lda   gbuf+39                  save address of the 1st bitmap.
         sta   vcbbuf+26,x
         lda   gbuf+40
         sta   vcbbuf+27,x
L3B04    clc                            indicate logged if possible
L3B05    rts
cmpvcb	equ	*-ofsX			compare volume name in vcb
         lda   gbuf+4                   with name in directory.
         and   #$0F
         cmp   vcbbuf,x                 are they the same length?
         stx   xvcbptr                  (see rev note #23)
         bne   L3B1E                    if not the same.
         tay
         ora   xvcbptr
         tax
L3B18    lda   gbuf+4,y
         cmp   vcbbuf,x
L3B1E    sec                            anticipate different names.
         bne   L3B26                    if not the same.
         dex
         dey
         bne   L3B18
         clc                            indicate match.
L3B26    ldx   xvcbptr                  offset to start of vcb (rev note #23)
         rts
tstdupvol equ	*-ofsX			check for other logged in volumes
         lda   #$00                     with the same name.
L3B2C    tax
         jsr   cmpvcb
         bcs   L3B41                    if no match.
         lda   vcbbuf+17,x              test for any open files.
         bmi   L3B4B                    cannot look at this volume.
         lda   #$00                     take duplicate offline if no open files
         sta   vcbbuf,x
         sta   vcbbuf+16,x
         beq   L3B49                    ok to log in new volume.
L3B41    txa                            index to next vcb
         clc
         and   #$E0                     strip odd stuff.
         adc   #$20                     inc to next entry.
         bcc   L3B2C                    branch if more to check
L3B49    clc
         rts
L3B4B    sta   duplflag                 duplicate has been found.
         stx   vcbentry                 save pointer to conflicting vcb.
         sec                            error.
         rts
tstfrblk equ	*-ofsX			test if enough free blocks available
         ldx   vcbptr                   for request.
         lda   vcbbuf+21,x              check if proper count for this volume.
         ora   vcbbuf+20,x
         bne   L3BAD                    branch if count is non-zero.
tkfrecnt equ	*-ofsX
         jsr   cntbms			get # of bitmaps
         sta   bmcnt                    and save.
         stz   scrtch                   start count at 0
         stz   scrtch+1
         lda   #$FF                     mark 'first free' temp as unknown
         sta   nofree
         jsr   upbmap                   update volume bitmap.
         bcs   L3BC1                    if error.
         ldx   vcbptr                   get address of 1st bitmap
         lda   vcbbuf+26,x
         sta   bloknml
         lda   vcbbuf+27,x
         sta   bloknml+1
L3B81    jsr   rdgbuf                   use general buffer for temp space to
         bcs   L3BC1                    count free blocks (bits).
         jsr   count
         dec   bmcnt                    was that the last bitmap?
         bmi   L3B96                    if so, go change fcb so not done again.
         inc   bloknml
         bne   L3B81
         inc   bloknml+1
         bra   L3B81
L3B96    ldx   vcbptr                   mark which block had 1st free space
         lda   nofree
         bmi   L3BBE                    if no free space was found.
         sta   vcbbuf+28,x              update the free count.
         lda   scrtch+1                 
         sta   vcbbuf+21,x              update volume control byte.
         lda   scrtch
         sta   vcbbuf+20,x
L3BAD    lda   vcbbuf+20,x              compare total available free blocks
         sec                            on this volume.
         sbc   reql
         lda   vcbbuf+21,x
         sbc   reqh
         bcc   L3BBE
         clc
         rts
L3BBE    lda   #$48			disk full
         sec
L3BC1    rts
count	equ	*-ofsX
         ldy   #$00
L3BC4    lda   gbuf,y			bit pattern.
         beq   L3BCC                    don't count
         jsr   cntfree
L3BCC    lda   gbuf+$100,y		do both pages with same loop
         beq   L3BD4
         jsr   cntfree
L3BD4    iny
         bne   L3BC4                    loop until all 512 bytes counted.
         bit   nofree                   has 1st block w/free space been found?
         bpl   L3BEE                    if yes.
         lda   scrtch                   test to see if any blocks were counted
         ora   scrtch+1
         beq   L3BEE                    branch if none counted.
         jsr   cntbms                   get total # of maps.
         sec                            subtract countdown from total bitmaps
         sbc   bmcnt
         sta   nofree
L3BEE    rts
cntfree	equ	*-ofsX
L3BEF    asl   a                        count the # of bits in this byte
         bcc   L3BFA
         inc   scrtch
         bne   L3BFA
         inc   scrtch+1
L3BFA    ora   #$00
         bne   L3BEF			loop until all bits counted
         rts
cntbms	equ	*-ofsX
         ldx   vcbptr
         ldy   vcbbuf+19,x              return the # of bitmaps
         lda   vcbbuf+18,x              possible with the total count
         bne   L3C0B                    found in the vcb.
         dey                            adj for bitmap block boundary
L3C0B    tya
         lsr   a                        divide by 16. the result is
         lsr   a                        the # of bitmaps.
         lsr   a
         lsr   a
         rts

* deallocate a block's entry in bitmap
* on entry, x,a = address of block

dealloc	equ	*-ofsX
         stx   bmcnt			high address of block.
         pha                            save low address.
         ldx   vcbptr                   check that bitmap block address is
         lda   vcbbuf+19,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   a                        get pointer to byte in block that
         lsr   bmcnt                    represents the block address.
         ror   a
         lsr   bmcnt
         ror   a
         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   vcbbuf+28,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   L3C77                    branch if on page 1 of bitmap
         ora   bmbuf+$100,y
         sta   bmbuf+$100,y
         bcs   L3C7D                    always.
bmbufhi	equ	*-ofsX			this address + 2 is used as an
L3C77    ora   bmbuf,y                  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   #$5A                     bitmap block # impossible.
         sec                            bitmap disk address wrong
         rts                            (maybe data masquerading as indx block)
alc1blk	equ	*-ofsX
         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   a                        multiply this and basval by 8
         rol   scrtch+1
         asl   a
         rol   scrtch+1
         asl   a
         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   a                        find left most 'on' bit
         bcs   L3CE4                    if found.
         inx                            adjust low address.
         bne   L3CDE                    always.
L3CE4    lsr   a                        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
         ldy   vcbptr                   subtract 1 from total free vcb blocks
         lda   vcbbuf+20,y              to account for newly allocated block.
         sbc   #$01                     (carry is set)
         sta   vcbbuf+20,y
         bcs   L3D10                    if high free count doesn't need adj.
         lda   vcbbuf+21,y              adjust high count
         dec   a
         sta   vcbbuf+21,y
L3D10    clc                            no errors.
         lda   scrtch                   return address in y,a of newly
         ldy   scrtch+1                 allocated block.
         rts
nxtbmap	equ	*-ofsX			inc to next bitmap
         ldy   vcbptr                   but 1st make sure there is another one.
         lda   vcbbuf+19,y
         lsr   a
         lsr   a
         lsr   a
         lsr   a
         cmp   vcbbuf+28,y              are there more maps ?
         beq   L3D60                    if no more to look at.
         lda   vcbbuf+28,y              add 1 to current map
         inc   a
         sta   vcbbuf+28,y
         jsr   upbmap
fndbmap	equ	*-ofsX
         ldy   vcbptr
         lda   vcbbuf+16,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   vcbbuf+16,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   vcbbuf+28,y
         asl   a                        2 pages per block
         sta   basval
         clc                            no errors.
L3D5F    rts
L3D60    lda   #$48                     request can't be filled
         sec                            error
         rts
upbmap	equ	*-ofsX
         clc                            
         lda   bmastat                  is current map modified ?
         bpl   L3D5F                    no.
         jsr   wrtbmap                  update device.
         bcs   L3D5F                    if error on writing.
         lda   #$00
         sta   bmastat			mark bitmap buffer as free
         rts
gtbmap	equ	*-ofsX                   read bitmap specified by dev and vcb.
         sta   bmadev
         ldy   vcbptr                   get lowest map # with free blocks in it
         lda   vcbbuf+28,y
         sta   bmacmap                  associate offset with bitmap ctrl block.
         clc				add this # to the base address of
         adc   vcbbuf+26,y              1st bitmap and save in bmadadr which
         sta   bmadadr                  is address of bitmap to be used.
         lda   vcbbuf+27,y
         adc   #$00
         sta   bmadadr+1
         lda   #$01                     read device command
L3D92    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   bmbufhi+2		address of the buffer (low = 0)
         jsr   dobitmap
         tax				error code (if any).
         pla                            restore current dev #
         sta   devnum
         bcc   L3DB6                    and return it if no error.
         txa                            error code
L3DB6    rts
rdblk	equ	*-ofsX
         sta   bloknml
         stx   bloknml+1
         jsr   rdgbuf
         rts
wrtbmap	equ	*-ofsX			write bitmap.
         lda   #$02                     write command.
         bne   L3D92                    always.
wrtgbuf	equ	*-ofsX
         lda   #$02			write command
         bne   L3DC9                    always.
rdgbuf	equ	*-ofsX
         lda   #$01                     read command.
L3DC9    sta   A4L                      pass to device handler.
         lda   #>gbuf                   general buffer.
dobitmap equ	*-ofsX
         php                            no interrupts
         sei
         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 #.
         jsr   dmgr                     call the driver.
         bcs   L3DE8                    if error.
         plp                            restore interrupts.
         clc
         rts
L3DE8    plp				file i/o error. restore interrupts.
         sec
         rts

* get mark command

getmark	equ	*-ofsX
         ldx   fcbptr			index to open fcb.
         ldy   #$02                     index to user's mark parmeter.
L3DF0    lda   fcbbuf+18,x              transfer current position
         sta   (A3L),y                  to user's parameter list
         inx
         iny
         cpy   #$05                     transfer 3 bytes
         bne   L3DF0
         clc
         rts
L3DFD    lda   #$4D			invalid position
         sec
         rts

* set mark command

setmark	equ	*-ofsX
         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.
L3E09    lda   (A3L),y			move it to 'tpos'
         sta   tposll-2,y
         bcc   L3E18                    branch if mark < eof
         cmp   fcbbuf+21,x
         bcc   L3E18                    branch if mark qualifies.
         bne   L3DFD                    branch if mark > eof (invalid position)
         dex
L3E18    dey                            move/compare next lower byte of mark.
         tya                            test for all bytes moved/tested.
         eor   #$01                     preserves carry status.
         bne   L3E09                    branch if more.
rdposn	equ	*-ofsX
         ldy   fcbptr			test to see if new position is
         lda   fcbbuf+19,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   fcbbuf+20,y
         bne   L3E44                    branch if not.
         jmp	svmark                   if so, adj fcb, position ptr and return.
L3E44    lda   fcbbuf+7,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   fcbbuf,y
         lda   #$43                     and report error
         sec
         rts
L3E59    lda   fcbbuf+7,y		use storage type as # of index levels
         sta   levels                   since 1=seed, 2=sapling, 3=tree.
         lda   fcbbuf+8,y
         and   #$40                     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   fcbbuf+20,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   datlevel                 no, use current indexes.
L3E89    lda   tposlh                   is new position < 512 ?
         lsr   a
         ora   tposhi
         bne   L3EEF                    no, mark both data and index block as
         lda   fcbbuf+12,y              unallocated. 1st block is only block
         sta   bloknml                  and it's data.
         lda   fcbbuf+13,y              high block address.
         jmp   rnewpos			go read in block and set statuses.
L3E9D    lda   fcbbuf+8,y               check to see if previous index block
         and   #$80                     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   a                        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   clrstats			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   fcbbuf+14,y
         lda   bloknml+1
         sta   fcbbuf+15,y
         bcc   datlevel			branch always
L3ED4    rts
posindex jsr   clrstats			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   a
         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
         bcs   L3ED4
datlevel lda   tposhi			get block address of data block
         lsr   a
         lda   tposlh                   ( if there is one )
         ror   a
         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    ldy   fcbptr			set status to show what's missing
         ora   fcbbuf+8,y
         sta   fcbbuf+8,y
         lsr   a                        discard bit that says data block
         lsr   a                        unallocated because carry indicates if
         jsr   zipdata                  index block is invalid and needs to be
         bcc   L3F61                    zeroed. branch if it doesn't need zeroed
         jsr   zeroindex		zero index block in user's i/o buffer
         bra   L3F61
zeroindex equ	*-ofsX                  
         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
zipdata	equ	*-ofsX
         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	equ	*-ofsX
         sta   bloknml+1
         jsr   rfcbdat
         bcs   L3F86			if error.
         jsr   clrstats                 show whole chain is allocated.
svmark	equ	*-ofsX
L3F61    ldy   fcbptr                   update position in fcb
         iny
         iny
         ldx   #$02
L3F68    lda   fcbbuf+18,y              save old mark in case calling routine
         sta   oldmark,x                fails later.
         lda   tposll,x
         sta   fcbbuf+18,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
clrstats equ	*-ofsX
         ldy   fcbptr                   clear allocation states for data block
         lda   fcbbuf+8,y               and both levels of indexes/
         and   #$F8
         sta   fcbbuf+8,y               indicates that either they exist now
         rts				or unnecessary for current position.
dirmark	equ	*-ofsX
         cmp   #$0D			is it a directory ?
         beq   L3F9C                    yes...
         lda   #$4A                     no, so compatability problem.
         jsr   p8errv                   should not have been opened !!!
L3F9C    lda   scrtch                   recover results of previous subtraction.
         lsr   a			use difference as counter for how many
         sta   cntent                   blocks must be read to get to new pos'n.
         lda   fcbbuf+19,y		test for positive direction
         cmp   tposlh                   indicated by carry.
         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   L3F61                    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   L3F61                    branch always.
dirpos1	equ	*-ofsX
         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   #$4C                     something is wrong with directory file!
L3FD6    sec				error.
         rts
L3FD8    sta   bloknml+1

* read file's data block

rfcbdat	equ	*-ofsX
         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   fcbbuf+16,y              save block # just read in fcb.
         lda   bloknml+1
         sta   fcbbuf+17,y
L3FF2    rts
rfcbidx	equ	*-ofsX			prepare to read index block.
         lda   #$01                     read command
         sta   A4L
         ldx   #$48                     address of current index buffer.
         jsr   fileio1                  go read index block.
         bcs   L400C                    error
         ldy   fcbptr
         lda   bloknml
         sta   fcbbuf+14,y              save block address of this index in fcb
         lda   bloknml+1
         sta   fcbbuf+15,y
         clc
L400C    rts
L400D    lda   #$02			write command
	dc	h'2C'			skip next instruction
rfcbfst	equ	*-ofsX
         lda	#$01			read command.
         pha                            save the command
         lda   #$0C
         ora   fcbptr                   add offset to fcbptr
         tay
         pla
         ldx   #$48                     rd block into index portion of file buf
dofileio equ	*-ofsX
         sta   A4L                      command
         lda   fcbbuf,y                 get disk block address from fcb.
         sta   bloknml                  block 0 not legal
         cmp   fcbbuf+1,y
         bne   L4031
         cmp   #$00                     are both bytes 0 ?
         bne   L4031                    no, continue request
         lda   #$0C                     otherwise, allocation error.
         jsr   sysdeath			doesn't return...
L4031    lda   fcbbuf+1,y		high address of disk block
         sta   bloknml+1
fileio1	equ	*-ofsX
         php                            no interrupts
         sei
         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
         ldy   fcbptr
         lda   fcbbuf+1,y
         sta   devnum                   along with device #.
         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.
         jsr   dmgr                     call the driver.
         bcs   L405E                    if error.
         plp                            restore interrupts
         clc
         rts
L405E    plp                            restore interrupts
         sec
         rts
wfcbfst	equ	*-ofsX
         jsr   upbmap			update the bitmap
         bra   L400D                    and write file's 1st block.
wfcbdat	equ	*-ofsX
         ldx   #datptr                  point at memory address with x and
         lda   #$10                     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   L408D
wfcbidx	equ	*-ofsX
         jsr   upbmap                   update bitmap.
         ldx   #$48                     point to address of index buffer
         lda   #$0E                     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.
L408D    ldy   fcbptr                   change status byte to reflect
         and   fcbbuf+8,y               successful disk file update.
         sta   fcbbuf+8,y               (carry is unaffected)
L4096    rts

openf	equ	*-ofsX
         jsr   findfile			look up the file.
         bcc   L40A0                    if ok.
         cmp   #$40                     is this opening a root directory ?
         bne   L40A7                    if not, then error.
L40A0    jsr   tstopen			are any other files writing to this
         bcc   L40AD                    same file ? branch if not.
L40A5    lda   #$50                     file is busy, shared access not allowed.
L40A7    sec
         rts
L40A9    lda   #$4B			file is wrong storage type.
         sec
         rts
L40AD    ldy   fcbptr			get address of 1st free fcb found.
         lda   fcbflg                   if this byte <> 0 then free fcb found
         bne   L40B9                    and available for use.
         lda   #$42                     fcb full error.
         sec
         rts
L40B9    ldx   #$1F                     assign fcb,
         lda   #$00                     but clean it first.
L40BD    sta   fcbbuf,y
         iny
         dex
         bpl   L40BD
         lda   #$06                     start claiming it by moving in file info
         tax				using x as source index
         ora   fcbptr                   and y as destination (fcb).
         tay
L40CB    lda   d_dev-1,x                move ownership info.
         sta   fcbbuf,y                 note: this code depends upon the defined
         dey				order of both the fcb and directory
         dex				entry buffer.
         bne   L40CB
         lda   d_stor                   get storage type and
         lsr   a                        strip off file name length
         lsr   a                        by dividing by 16.
         lsr   a
         lsr   a
         tax                            save in x for later comparison
         sta   fcbbuf+7,y               and in fcb for future access.
         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   fcbbuf+9,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   fcbbuf,y
         dex
         bpl   L4101			last loop stores hi address of 1st block
         sta   bloknml                  and this is the low one.
         ldy   fcbptr
         lda   cntent                   this was set up by 'tstopen'.
         sta   fcbbuf,y                 claim fcb for this file.
         jsr   alcbuffr			go allocate buffer in memory tables.
         bcs   L4147                    if errors.
         jsr   fndfcbuf                 rtn addr of bufs in data & index ptrs.
         lda   flevel                   mark level at which
         sta   fcbbuf+27,y              file was opened.
         lda   fcbbuf+7,y               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   fcbbuf+20,y              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.
         ldy   fcbptr                   free buffer space.
         lda   fcbbuf+11,y
         beq   L4156                    if no bufnum, ok because never alloc'd.
         jsr   relbuffr                 go release buffer.
         ldy   fcbptr                   since error was before file was
L4156    lda   #$00                     successfully opened, then it is
         sta   fcbbuf,y                 necessary to release fcb also.
         pla                            error code.
         sec
         rts
L415E    jsr   rfcbdat			read in 1st block of directory file.
         bcs   L4147                    return error after freeing buffer & fcb.
L4163    ldx   vcbptr			index to vcb.
         inc   vcbbuf+30,x              add 1 to # of files currently open
         lda   vcbbuf+17,x              and indicate that this volume has at
         ora   #$80                     least 1 file active.
         sta   vcbbuf+17,x
         ldy   fcbptr                   index to fcb.
         lda   fcbbuf,y                 return ref # to user.
         ldy   #$05
         sta   (A3L),y
         clc                            open is successful
         rts

* test open
* is there an open file?

tstopen	equ	*-ofsX
         lda   #$00
         sta   cntent			returns the ref # of a free fcb.
         sta   totent                   flag to indicate file already open.
         sta   fcbflg                   flag indicates a free fcb is available.
L4188    tay				index to next fcb.
         ldx   fcbflg                   test for free fcb found.
         bne   L4191                    if already found.
         inc   cntent
L4191    lda   fcbbuf,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   fcbbuf,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   fcbbuf+9,y               if it's already opened for write.
         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   #$20                     inc to next fcb.
         bne   L4188                    branch if more to compare.
         clc                            report no conflicts.
         rts

* read command

readf	equ	*-ofsX
         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.
         bne   L41DE                    branch if ok to read.
         lda   #$4E                     illegal access.
         bne   L4202                    always.
L41DE    bcc   L4205                    branch if result mark < eof. adjust
         ldy   fcbptr                   request to read until just before eof.
         lda   fcbbuf+21,y              result = (eof-1) - position
         sbc   tposll
         sta   cbytes
         sta   rwreql
         lda   fcbbuf+22,y
         sbc   tposlh
         sta   cbytes+1
         sta   rwreqh
         ora   cbytes                   if both bytes = 0 then eof error
         bne   L4210
         lda   #$4C			eof error
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   dread                    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   a                        if < 2 then use the slow way.
         beq   L421F
         sta   cmdtemp                  save bulk block count.
         jsr	gfcbstat		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                 inc all 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   a
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   L42C3                    yes, done.
         bne   L421F                    no, read last partial block
L427B    bcs   L4249
         lda   tposhi                   get index to next block address
         lsr   a
         lda   tposlh
         ror   a
         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
         clc
         php                            interrupts can't occur during dmgr call
         sei
         lda   datptr+1                 reset hi buffer address for dev handler
         sta   buf+1
         jsr   dmgr
         bcs   L42B6                    if error
         plp
         bcc   L424E                    no errors, branch always.
L42B6    plp                            restore interrupts.
L42B7    pha                            save error code.
         jsr   fxdatptr                 go restore data pointers, etc.
         pla
errfix1	equ	*-ofsX
         pha                            save error code
         jsr   rwdone                   pass back # of bytes actually read
         pla
         sec                            error
         rts
rwdone	equ	*-ofsX
L42C3    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	equ	*-ofsX
         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   fcbbuf+31,y              test for new line enabled.
         clc
         beq   L42F9                    if new line not enabled.
         sec                            carry indicates new line enabled
         sta   nlmask
         lda   fcbbuf+10,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 equ	*-ofsX
         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	 equ	*-ofsX			this byte ($60) is used to set v flag.
         rts
fxdatptr equ	*-ofsX			put current user buffer
         lda   datptr                   address back to normal
         sta   usrbuf
         lda   datptr+1
         sta   usrbuf+1                 bank pair byte should be moved also.
         ldy   fcbptr                   restore buffer address
         jmp   fndfcbuf

* read directory file

dread	equ	*-ofsX
L4384    jsr   rdposn
         bcs   L43B8			pass back any errors.
         jsr   preprw                   prepare for transfer.
         jsr   readpart                 move data to user's buffer.
         bvc   L4384                    repeat until request is satisfied.
         jsr   rwdone                   update fcb as to new position.
         bcc   L43B6                    branch if done with no errors.
         cmp   #$4C                     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   fcbbuf+16,x
         sta   (datptr),y
         lda   #$00			mark current block as impossible
         sta   fcbbuf+16,x
         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 equ	*-ofsX			move request count to a more
         ldy   #$04                     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   fcbbuf+9,y               a = attributes
         clc                            and carry clear...
         rts
mvdbufr	equ	*-ofsX			move the pointer to user's buffer
         ldy   #$02                     to the block file manager
         lda   (A3L),y
         sta   usrbuf                   z-page area
         iny
         lda   (A3L),y
         sta   usrbuf+1
gfcbstyp equ	*-ofsX
         ldy   fcbptr                   return storage type
         lda   fcbbuf+7,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	equ	*-ofsX
         ldx   #$00                     
         ldy   fcbptr
         clc
L43EE    lda   fcbbuf+18,y
         sta   tposll,x
         sta   oldmark,x
         adc   cbytes,x
         sta   scrtch,x
         txa
         eor   #$02			cbytes+2 always=0
         beq   L4406
         iny
         inx
         bne   L43EE			always.
eoftest	equ	*-ofsX
L4406    lda   scrtch,x			new mark in scrtch.
         cmp   fcbbuf+21,y              is new position > eof ?
         bcc   L4414                    no, proceed.
         bne   L4414                    yes, adjust 'cbytes' request
         dey
         dex                            all tree bytes compared ?
         bpl   L4406                    no, test next lowest
L4414    rts
werreof	equ	*-ofsX
         jsr   plus2fcb			reset eof to pre-error position.
L4418    lda   oldeof,x                 place oldeof back into fcb
         sta   fcbbuf+21,y
         lda   oldmark,x                also reset mark to last best
         sta   fcbbuf+18,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	equ	*-ofsX
         jsr   plus2fcb			get y=fcbptr+2, x=2, a=y.
L4434    lda   fcbbuf+21,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   fcbbuf+21,y
L4442    dey
         dex                            copy all 3 bytes
         bpl   L4434
         rts
plus2fcb equ	*-ofsX
         lda   #$02                     on exit both a and y = fcbptr+2.
         tax                            x = 2
         ora   fcbptr
         tay
         rts

* write command

writef	equ	*-ofsX			first determine if requested
         jsr   mvcbytes                 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   gfcbstat
         and   #$07
         beq   L44E9
         ldy   #$00			is enough disk space available for
L4487    iny                            indexes and data block ?
         lsr   a
         bne   L4487
         sty   reql
         sta   reqh
         jsr   tstfrblk
         bcs   L44A2                    pass back any errors.
         jsr   gfcbstat                 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   gfcbstat                 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   gfcbstat                 clear allocation required bits in status
         ora   #$80			but first indicate index block is dirty.
         and   #$F8
         sta   fcbbuf+8,y
         lda   tposhi			calculate position within index block.
         lsr   a
         lda   tposlh
         ror   a
         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   fcbbuf+16,y              is allocated.
         txa                            get high address again.
         sta   fcbbuf+17,y
L44E9    jsr   preprw
         jsr   wrtpart
         bvc   L4479
         jmp   rwdone                   update fcb with new position
wrtpart	equ	*-ofsX
         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   #$4D                     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
         jsr   gfcbstat
         ora   #$50
         sta   fcbbuf+8,y
         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	equ	*-ofsX
         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   a                        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   fcbbuf+15,y              index block.
         txa
         sta   fcbbuf+14,y
         jsr   wfcbfst                  save new top of tree
         bcs   L45B1
         jmp   zeroindex                zero index block in user's i/o buffer.
sapdown	equ	*-ofsX
         jsr   gfcbstyp			find out if dealing with a tree.
         cmp   #$01                     if seed then adj to file type is needed.
         beq   L45B2			branch if seed
         jsr   rfcbfst                  otherwise read in top of tree.
         bcc   L457A                    if no error.
L45B1    rts                            return errors.
swapdown equ	*-ofsX			make current seed into a sapling.
L45B2    jsr   alcwblk                  allocate a block before swap.
         bcs   L45F6                    return errors.
         ldy   fcbptr                   get previous first block
         lda   fcbbuf+12,y              address into index block.
         pha                            save temporarily while swapping in new
         lda   scrtch                   top index. get new block address (low)
         tax
         sta   fcbbuf+12,y
         lda   fcbbuf+13,y
         pha
         lda   scrtch+1                 and high address too
         sta   fcbbuf+13,y
         sta   fcbbuf+15,y              make new top also the current index in
         txa                            memory. get low address again.
         sta   fcbbuf+14,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   L45F6                    if error.
         jsr   gfcbstyp                 now adjust storage type by adding 1
         adc   #$01                     (seed becomes sapling becomes tree)
         sta   fcbbuf+7,y
         lda   fcbbuf+8,y               mark storage type modified
         ora   #$08
         sta   fcbbuf+8,y
         clc                            no error
L45F6    rts
alcwblk	equ	*-ofsX
         jsr   alc1blk
         bcs   L4616
         jsr   gfcbstat			mark usage as modified
         ora   #$10
         sta   fcbbuf+8,y
         lda   fcbbuf+24,y              inc current usage count by 1
         clc
         adc   #$01
         sta   fcbbuf+24,y
         lda   fcbbuf+25,y
         adc   #$00
         sta   fcbbuf+25,y
L4615    clc				no error
L4616    rts
tstwprot equ	*-ofsX			check for 'never been modified'
         jsr   gfcbstat                 condition
         and   #$F0
         bne   L4615                    ordinary rts if known write ok.
         lda   fcbbuf+1,y               get file's dev #.
         sta   devnum                   get current status of block device.
twrprot1 equ	*-ofsX			make the device status call
         sta   unitnum
         lda   bloknml+1
         pha
         lda   bloknml                  save the current block values
         pha
         stz   A4L
         stz   bloknml                  zero the block #
         stz   bloknml+1
         php
         sei
         jsr   dmgr
         bcs   L463B                    branch if write protect error
         lda   #$00                     otherwise, assume no errors.
L463B    plp                            restore interrupt status
         clc
         tax                            save error.
         beq   L4641                    branch if no error
         sec                            else, set carry to show error.
L4641    pla
         sta   bloknml                  restore the block #
         pla
         sta   bloknml+1
         txa
         rts                            carry is indeterminate.

* close command

closef	equ	*-ofsX                   close all ?
         ldy   #$01
         lda   (A3L),y
         bne   L4683                    no, just one of them.
         sta   cferr                    clear global close error.
         lda   #$00			start at the beginning.
L4654    sta   fcbptr                   save current low byte of pointer.
         tay                            get the level at which the file
         lda   fcbbuf+27,y              was opened.
         cmp   flevel                   if file's level is < global level
         bcc   L4675                    then don't close.
         lda   fcbbuf,y                 is this reference file open ?
         beq   L4675                    no, try next.
         jsr   flush2			clean it out...
         bcs   L46B6                    return flush errors.
         jsr   close2			update fcb & vcb
         ldy   #$01
         lda   (A3L),y
         beq   L4675                    no error if close all.
         bcs   L46B6                    close error.
L4675    lda   fcbptr                   inc pointer to next fcb
         clc
         adc   #$20
         bcc   L4654                    branch if within same page.
         lda   cferr                    on final close report logged errors.
         beq   L46B4                    branch if errors.
         rts                            (carry already set).
L4683    jsr   flush1			flush file 1st (including updating
         bcs   L46B6                    bitmap). branch if errors.
close2	equ	*-ofsX
         ldy   fcbptr
         lda   fcbbuf+11,y              release file buffer
         jsr   relbuffr
         bcs   L46B6
         lda   #$00
         ldy   fcbptr
         sta   fcbbuf,y                 free fcb too
         lda   fcbbuf+1,y
         sta   devnum                   go look for associated vcb
         jsr   fnddvcb
         ldx   vcbptr                   get vcb pointer.
         dec   vcbbuf+30,x              indicate one less file open.
         bne   L46B4                    branch if that wasn't the last...
         lda   vcbbuf+17,x
         and   #$7F                     strip 'files open' bit
         sta   vcbbuf+17,x
L46B4    clc
         rts
L46B6    bcs   L46E6                    don't report close all error now.

* flush command

flushf	equ	*-ofsX
         ldy   #$01			flush all ?
         lda   (A3L),y
         bne   L46E9			no, just one of them.
         sta   cferr                    clear global flush error.
         lda   #$00			start at the beginning.
L46C3    sta   fcbptr                   save current low byte of pointer.
         tay                            index to ref #.
         lda   fcbbuf,y                 is this reference file open ?
         beq   L46D1                    no, try next.
         jsr   flush2                   clean it out...
         bcs   L46E6                    return anty errors.
L46D1    lda   fcbptr                   inc pointer to next fcb.
         clc
         adc   #$20
         bcc   L46C3                    branch if within same page
L46D9    clc
         lda   cferr                    on last flush,
         beq   L46E0                    branch if no logged errors.
         sec                            report error now
L46E0    rts
flush2	equ	*-ofsX                   
         jsr   fndfcbuf                 must set up vcb & buffer locations 1st.
         bcc   L46F1                    branch if no error.
L46E6    jmp   glberr			error so check for close or flush all.
flush1	equ	*-ofsX                   for normal refnum flush,
L46E9    stz   cferr                    clear global error.
         jsr   findfcb                  setup pointer to fcb user references.
         bcs   L46E6                    return any errors.
L46F1    lda   fcbbuf+9,y               test to see if file is modified.
         and   #$02                     is it write enabled ?
         beq   L46D9                    branch if 'read only'
         lda   fcbbuf+28,y              has eof been modified ?
         bmi   L4704                    if yes.
         jsr   gfcbstat                 has data been modified ?
         and   #$70                     (was written to while it's been open?)
         beq   L46D9                    if not.
L4704    jsr   gfcbstat
         and   #$40                     does current data buffer need to be
         beq   L4710                    written ? branch if not.
         jsr   wfcbdat                  if so, go write it.
         bcs   L46E6                    if error.
L4710    jsr   gfcbstat                 check to see if the index block (tree
         and   #$80                     files only) needs to be written.
         beq   L471C                    branch if not.
         jsr   wfcbidx
         bcs   L46E6                    return any errors.
L471C    lda   #$06			prepare to update directory
         tax
         ora   fcbptr
         tay
L4723    lda   fcbbuf,y			note: this code depends on the defined
         sta   d_dev-1,x                order of the file control block and the
         dey                            temporary directory area in 'work space'
         dex
         bne   L4723
         sta   devnum
         lda   d_head			read the directory header for this file
         ldx   d_head+1
         jsr   rdblk                    into the general purpose buffer.
         bcs   L46E6                    if error.
         jsr   movhed0                  move header info.
         lda   d_entblk                 get address of directory block that
         ldy   d_entblk+1		contains the file entry.
         cmp   d_head                   test to see if it's the same block the
         bne   L474E                    header is in. branch if not.
         cpy   d_head+1
         beq   L4755                    branch if header block = entry block
L474E    sta   bloknml
         sty   bloknml+1
         jsr   rdgbuf                   get block with file entry in general
L4755    jsr   entcalc                  buffer. set up pointer to entry.
         jsr   moventry                 move entry to temp entry buffer in
         ldy   fcbptr                   'work space'. update 'blocks used' count
         lda   fcbbuf+24,y
         sta   d_usage
         lda   fcbbuf+25,y
         sta   d_usage+1
         ldx   #$00                     and move in end of file mark whether
L476C    lda   fcbbuf+21,y              needed or not.
         sta   d_eof,x
         inx
         cpx   #$03                     move all 3 bytes
         beq   L4780
         lda   fcbbuf+12,y              also move in the address of the file's
         sta   d_filid,x                first block since it might have changed
         iny                            since the file first opened.
         bne   L476C                    branch always.
L4780    lda   fcbbuf+5,y               the last thing to update is storage
         asl   a                        type (y=fcbptr+2). shift into high
         asl   a                        nibble.
         asl   a
         asl   a
         sta   scrtch
         lda   d_stor			get old type byte (might be the same).
         and   #$0F                     strip off old type,
         ora   scrtch                   add in the new type
         sta   d_stor                   and put it away.
         jsr   drevise                  go update directory.
         bcs   L47B4                    error.
         ldy   fcbptr                   mark
         lda   fcbbuf+28,y              fcb/directory
         and   #$7F                     as
         sta   fcbbuf+28,y              undirty.
         lda   d_dev                    see if bitmap should be written.
         cmp   bmadev                   is it in same as current file ?
         bne   L47B2                    yes, put it on the disk if necessary.
         jsr   upbmap                   go put it away.
         bcs   L47B4                    flush error
L47B2    clc
         rts

* report error only if not a close all or flush all

glberr	equ	*-ofsX	
L47B4    ldy   #$01
         pha
         lda   (A3L),y
         bne   L47C1			not an 'all' so report now
         clc
         pla
         sta   cferr                    save for later
         rts
L47C1    pla
         rts
gfcbstat equ	*-ofsX
         ldy   fcbptr                   index to fcb.
         lda   fcbbuf+8,y               return status byte.
         rts
L47CA    lda   #$4E                     access error
         sec
L47CD    rts

seteof	equ	*-ofsX			can only move end of tree, sapling
         jsr   gfcbstyp			or seed.
         cmp   #$04                     tree type ?
         bcs   L47CA                    if not then access error
         asl   a
         asl   a
         asl   a
         asl   a
         sta   stortyp                  may be used later.
         lda   fcbbuf+9,y
         and   #$02                     is write enabled to set new eof ?
         beq   L47CA                    no, access error.
         jsr   tstwprot                 hardware write protected ?
         bcs   L47CA                    yes, access error.
         ldy   fcbptr                   save old eof so it can be seen
         iny                            whether blocks need to be released
         iny                            upon contraction.
         ldx   #$02                     all 3 bytes of the eof
L47EF    lda   fcbbuf+21,y
         sta   oldeof,x
         dey
         dex
         bpl   L47EF
         ldy   #$04
         ldx   #$02
L47FD    lda   (A3L),y                  position mark to new eof
         sta   tposll,x
         dey
         dex
         bpl   L47FD
         ldx   #$02                     point to 3rd byte.
L4808    lda   oldeof,x                 see if eof moved backwards so blocks
         cmp   tposll,x                 can be released.
         bcc   L4815                    (branch if not)
         bne   purge                    branch if blocks to be released
         dex
         bpl   L4808                    all 3 bytes
eofset	equ	*-ofsX
L4815    ldy   #$04
         ldx   fcbptr			place new end of file into fcb
         inx
         inx
L481C    lda   (A3L),y
         sta   fcbbuf+21,x
         dex
         dey
         cpy   #$02                     all 3 bytes moved ?
         bcs   L481C                    no.
         jmp   fcbused                  mark fcb as dirty.
purge    jsr   flush1                   make sure file is current
         bcs   L47CD
         ldx   datptr+1                 pointer to index block
         inx
         inx
         stx   zpt+1                    (zero page conflict with dir buf ptr)
         ldx   datptr
         stx   zpt
         ldy   fcbptr                   check if eof < mark
         iny
         iny
         ldx   #$02
L4840    lda   fcbbuf+18,y
         cmp   tposll,x                 compare until not equal or carry clear.
         bcc   L485F                    branch if eof > mark.
         bne   L484E                    branch if eof < mark.
         dey
         dex
         bpl   L4840                    compare all 3 bytes
L484E    ldy   fcbptr
         ldx   #$00
L4853    lda   tposll,x                 fake position, correct position will
         sta   fcbbuf+18,y              be made below...
         iny
         inx
         cpx   #$03                     move all 3 bytes
         bne   L4853
L485F    jsr   tkfrecnt                 force free block count before releasing
         lda   tposll                   blocks. prepare for purge of excess...
         sta   dseed                    all blocks and bytes beyond new eof
         lda   tposlh                   must be zero'd
         sta   dsap
         and   #$01
         sta   dseed+1
         lda   tposhi
         lsr   a
         sta   dtree
         ror   dsap                     pass position in terms of block & bytes.
         lda   dseed			now adjust for boundaries of $200
         ora   dseed+1
         bne   L48A2                    branch if no adjustment necessary.
         lda   dsap                     get correct block ositions for sap
         sec                            and tree levels.
         sbc   #$01
         sta   dsap                     deallocate for last (phantom) block
         lda   #$02                     and don't modify last data block.
         bcs   L489F                    branch if tree level unaffected.
         dec   dtree
         bpl   L489F                    branch if new eof not zero
         lda   #$00
         sta   dtree                   otherwise, make a null seed out of it.
         sta   dsap
L489F    sta   dseed+1
L48A2    ldy   fcbptr                   also must pass file's 1st block address.
         lda   fcbbuf+12,y
         sta   firstbl
         lda   fcbbuf+13,y
         sta   firstbh
         stz   deblock			lastly, initialize # of blocks to
         stz   deblock+1                be free'd.
         jsr   detree			deallocate blocks from tree.
         php                            save any error status until fcb
         pha                            is cleaned up.
         sec
         ldy   fcbptr
         ldx   #$00
L48C2    lda   firstbl,x
         sta   fcbbuf+12,y              move in possible new first file block
         lda   fcbbuf+24,y              address. adjust usage count also
         sbc   deblock,x
         sta   fcbbuf+24,y
         iny
         inx
         txa
         and   #$01                     test for both bytes adjusted
         bne   L48C2                    without disturbing carry.
         lda   stortyp                  get possibly modified storage type
         lsr   a
         lsr   a
         lsr   a
         lsr   a
         ldy   fcbptr                   and save it in fcb.
         sta   fcbbuf+7,y
         jsr   clrstats                 make it look as though position has
         jsr   dvcbrev			nothing allocated, update total blocks
         ldy   fcbptr                   in fcb and correct position.
         iny
         iny
         ldx   #$02
L48F2    lda   fcbbuf+18,y              tell 'rdposn' to go to correct
         sta   tposll,x
         eor   #$80                     position from incorrect place.
         sta   fcbbuf+18,y
         dey
         dex
         bpl   L48F2
         jsr   rdposn                   go to correct position.
         bcc   L490D                    if no error.
         tax                            otherwise, report latest error.
         pla
         plp
         txa                            restore latest error code to stack
         sec
         php
         pha                            save new error.

* mark file as in need of a flush and update fcb with new end of file,
* then flush it.

L490D    jsr   eofset			go mark and update
         jsr   flush1			then go do the flush.
         bcc   L491C                    branch if no error.
         tax                            save latest error.
         pla                            clean previous error off stack
         plp
         txa                            and restore latest error to stack.
         sec                            show error condition.
         php                            restore error status to stack
         pha                            and the error code.
L491C    pla                            report any errors that may have
         plp                            appeared.
         rts

geteof	equ	*-ofsX
         ldx   fcbptr			index to end of file mark
         ldy   #$02                     and index to user's call parameters
L4924    lda   fcbbuf+21,x
         sta   (A3L),y
         inx
         iny
         cpy   #$05
         bne   L4924                    loop until all 3 bytes moved
         clc                            no errors
         rts

newline	equ	*-ofsX
         ldy   #$02			adjust newline status for open file.
         lda   (A3L),y                  on or off ?
         ldx   fcbptr                   it will be 0 if off.
         sta   fcbbuf+31,x              set new line mask
         iny
         lda   (A3L),y                  and move in 'new-line' byte
         sta   fcbbuf+10,x
         clc                            no error possible
         rts

getinfo	equ	*-ofsX
         jsr   findfile			look for file.
         bcc   L4988                    no error.
         cmp   #$40                     was it a root directory file ?
         sec                            (in case of no match)
         bne   L49A4                    if not, then error.
         lda   #$F0
         sta   d_stor                   for get info, report proper storage
         stz   reql                     type. forca a count of free blocks.
         stz   reqh
         ldx   vcbptr
         jsr   tkfrecnt                 get a fresh count of free blocks on
         ldx   vcbptr                   this volume.
         lda   vcbbuf+21,x              return total blocks and total in use.
         sta   reqh                     1st transfer 'free' blocks to zpage
         lda   vcbbuf+20,x              for later subtraction to determine
         sta   reql                     the 'used' count.
         lda   vcbbuf+19,x              transfer to 'd.' table as aux id
         sta   d_auxid+1                (total block count is considered aux id
         pha                             for the volume)
         lda   vcbbuf+18,x
         sta   d_auxid
         sec                            subtract and report the number of
         sbc   reql                     blocks 'in use'
         sta   d_usage
         pla
         sbc   reqh
         sta   d_usage+1
L4988    lda   d_stor                   transfer bytes from internal order to
         lsr   a                        call spec via 'inftabl' translation
         lsr   a                        table but first change storage type to
         lsr   a                        external (low nibble) format.
         lsr   a
         sta   d_stor
         ldy   #$11                     index to last of user's spec table.
L4994    lda   inftabl-3,y
         and   #$7F                     strip bit used by setinfo
         tax
         lda   d_stor,x                 move directory info to call spec. table
         sta   (A3L),y
         dey
         cpy   #$03
         bcs   L4994                    if all info bytes moved, retn carry clr
L49A4    rts

setinfo	equ	*-ofsX
         jsr   findfile			get the file to work on.
         bcs   L49CF                    if error.
         lda   bubit                    see if backup bit can be cleared
         eor   #$20
         and   d_attr
         and   #$20
         sta   bkbitflg                 or preserve current...
         ldy   #$0D                     init pointer to user supplied list.
L49B9    ldx   inftabl-3,y              get index to corresponding 'd.' table.
         bmi   L49C3                    branch if parameter can't be set.
         lda   (A3L),y
         sta   d_stor,x
L49C3    dey                            has user's request been satisfied ?
         cpy   #$03
         bcs   L49B9                    no, move next byte.
         and   #$18			make sure no illegal access bits were
         beq   L49D0                    set !! branch if legal access.
         lda   #$4E                     otherwise, access error.
         sec
L49CF    rts
L49D0    ldy   #$0B
         lda   (A3L),y                  was clock null input ?
         beq   L49D9                    if yes.
         jmp   drevise1                 end by updating directory.
L49D9    jmp   drevise                  update with clock also...

rename	equ	*-ofsX
         jsr   lookfile			look for source (original) file.
         bcc   L4A1E                    if found.
         cmp   #$40                     trying to rename a volume ?
         bne   L49FD                    no, return error.
         jsr   renpath			syntax new name.
         bcs   L49FD                    rename error.
         ldy   pathbuf                  find out if only rootname for new name
         iny
         lda   pathbuf,y                must be $FF if volume name only.
         bne   L4A72                    if not single name
         ldx   vcbptr                   check for open files before changing.
         lda   vcbbuf+17,x
         bpl   L49FF                    if volume not busy.
         lda   #$50                     file busy error.
L49FD    sec
         rts
L49FF    ldy   #$00                     get newname's length
         lda   pathbuf,y
         ora   #$F0                     (root file storage type)
         jsr   mvrotnam			update root directory.
         bcs   L4A74                    rename error.
         ldy   #$00
         ldx   vcbptr                   update vcb also.
L4A10    lda   pathbuf,y                move new name to vcb.
         beq   L4A1C
         sta   vcbbuf,x
         iny                            next character
         inx
         bne   L4A10                    always.
L4A1C    clc                            no errors
         rts
L4A1E    jsr   getnamptr		set y = 1st char of path, x = 0.
L4A21    lda   pathbuf,y                move original name to gbuf
         sta   gbuf,x                   for later comparison to new name.
         bmi   L4A2D                    if last character has been moved
         iny                            otherwise, get the next one.
         inx
         bne   L4A21                    always.
L4A2D    jsr   renpath                  get new name syntaxed.
         bcs   L4A74                    rename error.
         jsr   getnamptr                set y = path, x = 0.
         lda   pathbuf,y                now compare new name with old name
L4A38    cmp   gbuf,x                   to make sure they are in the same dir.
         php                            save result of comparison.
         and   #$F0                     was last char really a count ?
         bne   L4A46                    if not.
         sty   rnptr                    save pointer to next name, it might
         stx   namptr                   be the last.
L4A46    plp                            result of last comparison ?
         bne   L4A52                    branch if different character or count.
         inx                            bump pointers.
         iny
         lda   pathbuf,y                was it the last character ?
         bne   L4A38                    if not.
         clc                            no operation, names were the same.
         rts
L4A52    ldy   rnptr                    index to last name in the chain.
         lda   pathbuf,y                get last name length.
         sec
         adc   rnptr
         tay
         lda   pathbuf,y                this byte should be $00 !
         bne   L4A72                    if not, bad path error.
         ldx   namptr                   index to last of original name
         lda   gbuf,x
         sec
         adc   namptr
         tax
         lda   gbuf,x                   this byte should also be $00.
         beq   L4A76                    if so, continue processing.
L4A72    lda   #$40                     bad pathname error.
L4A74    sec
         rts
L4A76    jsr   lookfile			test for duplicate file name.
         bcs   L4A7F                    branch if file not found, which is ok !!
         lda   #$47                     duplicate name error.
         sec
         rts
L4A7F    cmp   #$46                     was it a valid file not found ?
         bne   L4A74                    no, rename error.
         jsr   setpath                  syntax pathname of file to be changed.
         jsr   findfile                 get all the info on this file.
         bcs   L4A74                    rename error.
         jsr   tstopen                  is file in use ?
         lda   #$50                     anticipate file busy error.
         bcs   L4A74                    error if in use.
         lda   d_attr                   test bit which allows rename.
         and   #$40
         bne   L4A9D                    branch if ok to rename
         lda   #$4E                     otherwise, illegal access.
L4A9B    sec
         rts
L4A9D    lda   d_stor                   find out which storage type.
         and   #$F0                     strip off name length.
         cmp   #$D0                     is it a directory ?
         beq   L4AAE                    then ok.
         cmp   #$40                     is it a seed, sapling or tree ?
         bcc   L4AAE                    then ok.
         lda   #$4A                     file incompatible error.
         bne   L4A9B                    always.
L4AAE    jsr   renpath                  since both names go into the directory,
         bcs   L4A74                    syntax the new name to get the local
         ldy   rnptr                    name address. y = index to local name
         ldx   pathbuf,y                length. adj y to last char of new name.
         tya
         adc   pathbuf,y
         tay
L4ABE    lda   pathbuf,y                move local name to dir entry workspace.
         sta   d_stor,x
         dey
         dex
         bne   L4ABE
         lda   d_stor                   preserve file storage type.
         and   #$F0                     strip off old name length.
         tax
         ora   pathbuf,y                add in new name's length.
         sta   d_stor
         cpx   #$D0                     that file must be changed also.
         bne   L4AF0                    branch if not directory type.
         lda   d_frst                   read in 1st header block of subdir
         ldx   d_frst+1
         jsr   rdblk
         bcs   L4A74                    errors.
         ldy   rnptr                    change the header's name to match the
         lda   pathbuf,y                owner's new name. get local name length.
         ora   #$E0			assume it's a header.
         jsr   mvrotnam
         bcs   L4A74
L4AF0    jmp   drevise1                 end by updating all path directories.
mvrotnam equ	*-ofsX
         ldx   #$00
L4AF5    sta   gbuf+4,x
         inx
         iny
         lda   pathbuf,y
         bne   L4AF5
         jmp   wrtgbuf                  write changed header block.
renpath	equ	*-ofsX                   
         ldy   #$03                     get address to new pathname
         lda   (A3L),y
         iny
         sta   zpt
         lda   (A3L),y                  set up for syntaxing routine (synpath)
         sta   zpt+1
         jmp   synpath			do syntax (returns y = local namelength)
getnamptr equ	*-ofsX
         ldy   #$00			return pointer to 1st name of path.
         bit   prfxflg                  is this a prefixed name ?
         bmi   L4B1A                    branch if not.
         ldy   newpfxptr
L4B1A    ldx   #$00
         rts

destroy	equ	*-ofsX
         jsr   findfile			look for file to be destroyed.
         bcs   L4B66                    if error.
         jsr   tstopen                  is it open ?
         lda   totent
         bne   L4B64                    error if open.
         stz   reql                     force proper free count in volume.
         stz   reqh                     (no disk access occurs if already
         jsr   tstfrblk                  proper)
         bcc   L4B39			no errors.
         cmp   #$48                     was error a full disk ?
         bne   L4B66                    no, report error.
L4B39    lda   d_attr                   make sure ok to destroy file.
         and   #$80
         bne   L4B45                    branch if ok to destroy.
         lda   #$4E                     access error
         jsr   p8errv                   (returns to caller)
L4B45    lda   devnum                   last device used.
         jsr   twrprot1                 test for write protected hardware
         bcs   L4B66                    before going thru deallocation.
         lda   d_frst                   'detree' needs first block address
         sta   firstbl
         lda   d_frst+1
         sta   firstbh
         lda   d_stor                   find out which storage type.
         and   #$F0                     strip off name length.
         cmp   #$40                     is it a seed, sapling or tree ?
         bcc   L4B68                    branch if it is.
         bra   L4BCF                    otherwise, test for directory destroy.
L4B64    lda   #$50			file busy error.
L4B66    sec                            can't be destroyed
         rts
L4B68    sta   stortyp                  destroy a tree file. save storage type.
         ldx   #$05
         lda   #$00                     set 'detree' input variables, must be
L4B6F    sta   stortyp,x                in order: deblock, dtree, dsap, dseed.
         dex
         bne   L4B6F                    loop until all zero'd.
         lda   #$02                     this avoids an extra file i/o and pre-
         sta   dseed+1                  vents destruction of any deleted data.
         inc   delflag                  don't allow detree to zero index blocks.
         jsr   detree			make trees and saplings into seeds.
         dec   delflag                  reset flag.
         bcs   L4B93                    (de-evolution)
L4B85    ldx   firstbh
         lda   firstbl                  now deallocate seed.
         jsr   dealloc
         bcs   L4B93
         jsr   upbmap
L4B93    pha                            save possible error code.
         lda   #$00                     update directory to free entry space.
         sta   d_stor
         cmp   h_fcnt                   file entry wrap ?
         bne   L4BA1                    branch if no carry adjustment.
         dec   h_fcnt+1                 take carry from hi byte of file entries.
L4BA1    dec   h_fcnt			mark header with one less file.
         jsr   dvcbrev                  go update block count in vcb (ignore
         jsr   drevise                   error, if any) and update dir last.
         tax                            save possible new error code,
         pla                            restore possible old error code.
         bcc   L4BAF                    branch if last call succeeded.
         txa                            last call failed, use it's error code.
L4BAF    cmp   #$01                     adjust carry accordingly
         rts
dvcbrev	equ	*-ofsX                   update block free count in vcb.
         ldy   vcbptr                   point to vcb of correct device.
         lda   deblock                  get # of blocks recently freed.
         adc   vcbbuf+20,y
         sta   vcbbuf+20,y              update current free block count.
         lda   deblock+1
         adc   vcbbuf+21,y
         sta   vcbbuf+21,y
         lda   #$00                     force re-scan from 1st bitmap
         sta   vcbbuf+28,y
         rts
L4BCD    bcc   L4B85                    branch widened (always taken)
L4BCF    cmp   #$D0                     is this a directory file ?
         bne   L4C1B                    no, file incompatible.
         jsr   fndbmap                  make sure a buffer available for bitmap
         bcs   L4C1A                    if error.
         lda   d_frst                   read 1st block of directory into gbuf
         sta   bloknml
         lda   d_frst+1
         sta   bloknml+1
         jsr   rdgbuf
         bcs   L4C1A
         lda   gbuf+37                  do any files exist in this directory ?
         bne   L4BF1                    if so, access error.
         lda   gbuf+38
         beq   L4BF6
L4BF1    lda   #$4E                     access error.
         jsr   p8errv                   P8 error vector
L4BF6    sta   gbuf+4                   make it an invalid subdirectory
         jsr   wrtgbuf
         bcs   L4C1A
L4BFE    lda   gbuf+2                   get forward link.
         cmp   #$01                     test for null block into carry.
         ldx   gbuf+3                   get the rest of the block address.
         bne   L4C0A                    branch if not null.
         bcc   L4BCD                    was the low part null as well ?
L4C0A    jsr   dealloc                  free this block.
         bcs   L4C1A
         lda   gbuf+2
         ldx   gbuf+3
         jsr   rdblk
         bcc   L4BFE                    loop until all freed
L4C1A    rts
L4C1B    lda   #$4A                     file incompatible
         jsr   p8errv			(returns to caller)
fcbused	equ	*-ofsX			mark fcb as dirty so the directory
         pha                            will be flushed on 'flush'.
         tya                            save regs.
         pha
         ldy   fcbptr
         lda   fcbbuf+28,y              fetch current fcb dirty byte.
         ora   #$80                     mark fcb as dirty.
         sta   fcbbuf+28,y              save it back
         pla                            and restore regs.
         tay
         pla
         rts

* 'detree' deallocates blocks from tree files. it is assumed that the device has
* been pre-selected and the 'gbuf' may be used.
*
* on entry:
*    stortype = storage type in upper nibble, lower nibble is undisturbed.
*    firstbl & firstbh = first block of file (index or data).
*    deblock = 0
*    dtree = ptr to 1st block with data to be deallocated at tree level.
*    dsap = ptr to 1st block at sapling level.
*    dseed = byte (0-511) position to be zeroed from (inclusive).
*
* on exit:
*    stortype = modified result of storage type (if applicable).
*    firstbl & h = modified if storage type changed.
*    deblock = total number of blocks freed at all levels.
*    dtree, dsap, deseed unchanged.
*
* to trim a tree to a seed file, both dtree and dsap must be zero.
* to go from tree to sapling, dtree alone must be zero.

detree	equ	*-ofsX
         lda   stortyp			which kind of tree ?
         cmp   #$20                     is it a 'seed' ?
         bcc   L4C46                    if yes.
         cmp   #$30                     a sapling ?
         bcc   L4C51                    if yes.
         cmp   #$40                     is it at least a 'tree' ?
         bcc   L4C59                    branch if it is.
         lda   #$0C                     block allocation error.
         jsr   sysdeath			P8 system death vector

* seedling file type - make sure first desireable block is the only
* block available in a seedling file.

L4C46    lda   dsap
         ora   dtree
         bne   L4CC2	
         jmp   seedel0

* sapling file type - make sure first desireable block is within the range of
* blocks available in a sapling file

L4C51    lda   dtree			can't have any blocks in this range
         bne   L4CC2                    if so then done
         jmp   sapdel0                  else go deallocate
L4C59	lda   #$80
         sta   topdest                  for tree top start at end, work backwards.
L4C5E    jsr   drdfrst                  read specified first block into gbuf.
         bcs   L4CC2                    return errors.
         ldy   topdest                  get current pointer to top indexes.
         cpy   dtree                    have enough sapling indexes been
         beq   L4CC3                    deallocated? yes, now deallocate blocks
         ldx   #$07			buffer up to 8 sapling index block
L4C6D    lda   gbuf,y			addresses. fetch low block address
         sta   dealbufl,x               and save it.
         ora   gbuf+$100,y		is it a real block that is allocated?
         beq   L4C81                    branch if phantom block.
         lda   gbuf+$100,y              fetch high block address
         sta   dealbufh,x               and save it.
         dex                            decrement and test for dealc buf filled.
         bmi   L4C93			branch if 8 addresses fetched.
L4C81    dey                            look for end of deallocation limit.
         cpy   dtree                    is this the last position on tree level?
         bne   L4C6D                    if not.
         iny
         lda   #$00                     fill rest of dealc buffer with null addresses.
L4C8A    sta   dealbufl,x
         sta   dealbufh,x
         dex
         bpl   L4C8A
L4C93    dey                            decrement to prepare for next time.
         sty   topdest                  save index.
         ldx   #$07
L4C99    stx   dtmpx                    save index to dealc buf.
         lda   dealbufl,x
         sta   bloknml
         ora   dealbufh,x               finished ?
         beq   L4C5E                    branch if done with this level.
         lda   dealbufh,x               complete address with high byte,
         sta   bloknml+1
         jsr   rdgbuf                   read sapling level into gbuf.
         bcs   L4CC2                    return errors.
         jsr   dealblk			go free all data indexes in this block
         bcs   L4CC2
         jsr   wrtgbuf                  write the flipped index block
         bcs   L4CC2
         ldx   dtmpx                    restore index to dealc buff.
         dex                            are there more to free?
         bpl   L4C99                    branch if so.
         bmi   L4C5E                    branch always to get up to 8 more
L4CC2    rts                            sapling block numbers.
L4CC3    ldy   dtree                    deallocate all sapling blocks greater
         iny                            than specified block.
         jsr   dalblk1			(master index in gbuf)
         bcs   L4CC2                    if errors.
         jsr   wrtgbuf                  write updated master index back to disk.
         bcs   L4CC2
         ldy   dtree			figure out if tree can become sapling.
         beq   L4CEB                    branch if it can.
         lda   gbuf,y                   otherwise, continue with partial.
         sta   bloknml                  deallocation of last sapling index.
         ora   gbuf+$100,y              is there such a sapling index block ?
         beq   L4CC2                    all done if not.
         lda   gbuf+$100,y              read in sapling level to be modified.
         sta   bloknml+1
         jsr   rdgbuf                   read highest sapling index into gbuf.
         bcc   L4CF5
         rts
L4CEB    jsr   shrink			shrink tree to sapling
         bcs   L4CC2
sapdel0	equ	*-ofsX
         jsr   drdfrst                  read specified sapling level index
         bcs   L4CC2                    into gbuf. branch if error.
L4CF5    ldy   dsap                     pointer to last of desirable indexes.
         iny                            inc to 1st undesirable.
         beq   L4D05                    branch if all are desirable.
         jsr   dalblk1                  deallocate all indexes above specified.
         bcs   L4CC2
         jsr   wrtgbuf                  write out the index block
         bcs   L4CC2
L4D05    ldy   dsap                     prepare to clean up last data block.
         beq   L4D1F                    branch if possibility of making a seed.
L4D0A    lda   gbuf,y                   fetch low order data block address.
         sta   bloknml
         ora   gbuf+$100,y              is it a real block ?
         beq   L4CC2                    if not, then done.
         lda   gbuf+$100,y
         sta   bloknml+1
         jsr   rdgbuf                   go read data block into gbuf.
         bcc   L4D2E                    branch if good read
         rts                            or return error.
L4D1F    lda   dtree                    are both tree and sap levels zero ?
         bne   L4D0A                    if not.
         jsr   shrink                   reduce this sap to a seed.
         bcs   L4D52                    if error.
seedel0	equ	*-ofsX
         jsr   drdfrst                  go read data block.
         bcs   L4D52                    if error.
L4D2E    ldy   dseed+1                  check high byte for no deletion.
         beq   L4D39                    branch if all of 2nd page to be deleted.
         dey				if dseed > $200 then all were done.
         bne   L4D52                    branch if that is the case.
         ldy   dseed                    clear only bytes >= dseed.
L4D39    lda   #$00
L4D3B    sta   gbuf+$100,y              zero out unwanted data
         iny
         bne   L4D3B
         ldy   dseed+1                  is that all ?
         bne   L4D4F                    yes.
         ldy   dseed
L4D49    sta   gbuf,y
         iny
         bne   L4D49
L4D4F    jmp   wrtgbuf                  update data block to disk.
L4D52    rts                            return error status.
drdfrst	equ	*-ofsX			read specified 1st block into gbuf
         lda   firstbl
         ldx   firstbh
         jmp   rdblk                    go read it

* beware that dealloc may bring in a new bitmap block and may destroy
* locations 46 and 47 which are used to point to the current index block.

shrink	equ	*-ofsX
         ldx   firstbh			first deallocate top index block
         txa
         pha
         lda   firstbl
         pha                            save block address of this index block.
         jsr   dealloc                  free it from the bitmap
         pla
         sta   bloknml                  set master of sapling
         pla				index block address.
         sta   bloknml+1
         bcs   L4D8D                    report errors.
         lda   gbuf                     get # of new 1st block from old index.
         sta   firstbl
         lda   gbuf+$100
         sta   firstbh
         ldy   #$00
         jsr   swapme			flip that one entry in old top index.
         sec                            now change file type,
         lda   stortyp                  from tree to sapling,
         sbc   #$10                     or from sapling to seed.
         sta   stortyp
         jsr   wrtgbuf                  write the (deallocated) old top index.
L4D8D    rts                            return error status.
dealblk	equ	*-ofsX
         ldy   #$00                     start at beginning.
dalblk1	equ	*-ofsX
         lda   bloknml                  save disk address of gbuf's data.
         pha
         lda   bloknml+1
         pha
L4D96    sty   saptr                    save current index.
         lda   gbuf,y                   get low address of block to deallocate.
         cmp   #$01                     test for null block into carry.
         ldx   gbuf+$100,y              get remainder of block address.
         bne   L4DA5                    branch if not null.
         bcc   L4DB0                    was the low part null too ?
L4DA5    jsr   dealloc                  free it up on volume bitmap.
         bcs   L4DB4                    return any error.
         ldy   saptr                    get index to sapling level index block.
         jsr   swapme                   
L4DB0    iny                            next block address.
         bne   L4D96                    if more to deallocate or test.
         clc                            no error.
L4DB4    tax                            save error code, if any.
         pla                            restore blocknm (16 bit)
         sta   bloknml+1
         pla
         sta   bloknml
         txa                            restore return code
         rts
swapme	equ	*-ofsX
         lda   delflag                  swapping or zeroing ?
         bne   L4DC5                    skip if swapping.
         tax                            make x = 0.
         beq   L4DCB                    zero the index (always taken).
L4DC5    ldx   gbuf+$100,y              index high
         lda   gbuf,y                   index low
L4DCB    sta   gbuf+$100,y              save index high
         txa
         sta   gbuf,y                   save index low
         rts				done.

* MEMMGR memory manager
*
* allocate buffer in memory tables

alcbuffr equ	*-ofsX
         ldy   #$04			index to user specified buffer.
alcbufr1 equ	*-ofsX                   
         lda   (A3L),y                  this buffer must be on a page boundary.
         tax                            save for validation.
         cmp   #$08
         bcc   L4E1E                    cannot be lower than video !
         cmp   #$BC			nor greater than $BB00
         bcs   L4E1E                    since it would wipe out globals...
         sta   datptr+1
         dey
         lda   (A3L),y                  low address should be zero !
         sta   datptr
         bne   L4E1E                    error if not page boundary.
         inx                            add 4 pages for 1k buffer.
         inx
         inx
         inx
L4DED    dex                            test for conflicts.
         jsr   cmembit			test for free buffer space
         and   memmap,y                 P8 memory bitmap
         bne   L4E1E                    report memory conflict, if any.
         cpx   datptr+1                 test all 4 pages.
         bne   L4DED
         inx                            add 4 pages again for allocation.
         inx
         inx
         inx
L4DFE    dex                            set proper bits to 1
         jsr   cmembit
         ora   memmap,y                 to mark it's allocation.
         sta   memmap,y
         cpx   datptr+1                 set all 4 pages
         bne   L4DFE
         ldy   fcbptr                   calculate buffer number
         lda   fcbbuf,y
         asl   a                        buffer number = (entnum) * 2.
         sta   fcbbuf+11,y              save it in fcb.
         tax                            use entnum * 2 as index to global
         lda   datptr+1			buffer addr tables. get addr already
         sta   buftbl-1,x               validated as good. store hi addr
         clc                            (entnums start at 1, not 0)
         rts
L4E1E    lda   #$56                     buffer is in use or not legal
         sec
         rts
getbufadr equ	*-ofsX
         tax				index into global buffer table.
         lda   buftbl-2,x
         sta   bufaddrl
         lda   buftbl-1,x
         sta   bufaddrh
         rts
relbuffr equ	*-ofsX			preserve buffer address in 'bufaddr'
         jsr   getbufadr
         tay                            returns high buffer address in acc.
         beq   L4E54                    branch if unallocated buffer space.
         stz   buftbl-1,x               take address out of buffer list.
         stz   buftbl-2,x               (x was set up by getbufadr)
freebuf	equ	*-ofsX
         ldx   bufaddrh                 get hi buffer address
         inx                            add 4 pages to account for 1k space.
         inx
         inx
         inx
L4E43    dex                            drop to next lower page.
         jsr   cmembit                  get bit and position to memtable of
         eor   #$FF                     this page. invert mask.
         and   memmap,y                 mark address as free space.
         sta   memmap,y
         cpx   bufaddrh                 all pages freed ?
         bne   L4E43                    no.
L4E54    clc                            no error.
         rts

* calculate memory allocation bit position.
* on entry: x = high address of buffer, low address assumed zero.
* on exit: acc = allocation bit mask, x = unchanged, y = pointer to memtabl byte

cmembit	equ	*-ofsX
         txa				page address
         and   #$07                     which page in any 2k set ?
         tay                            use as index to determine
         lda   whichbit,y               bit position representation.
         pha                            save bit position mask for now.
         txa                            page address.
         lsr   a
         lsr   a                        determine 2k set
         lsr   a
         tay                            return it in y.
         pla                            restore bit mask. return bit position
         rts                            in a & y, pointer to memtabl in x.
valdbuf	equ	*-ofsX
         lda   usrbuf+1                 high address of user's buffer
         cmp   #$02                     must be greater than page 2.
         bcc   L4E1E                    report bad buffer
         ldx   cbytes+1
         lda   cbytes                   get cbytes-1 value.
         sbc   #$01                     (carry is set)
         bcs   L4E76
         dex
L4E76    clc
         adc   usrbuf                   calculate end of request address.
         txa                            do high address.
         adc   usrbuf+1                 the final address
         tax                            must be less than $BFnn (globals)
         cpx   #$BF
         bcs   L4E1E                    report bad buffer.
         inx                            loop thru all affected pages.
vldbuf1	equ	*-ofsX
L4E82    dex                            check next lower page.
         jsr   cmembit
         and   memmap,y                 if 0 then no conflict.
         bne   L4E1E                    branch if conflict.
         cpx   usrbuf+1                 was that the last (lowest) page ?
         bne   L4E82                    if not.
         clc                            all pages ok.
         rts

getbuf	equ	*-ofsX			give user address of file buffer
         ldy   #$02                     referenced by refnum.
         lda   bufaddrl
         sta   (A3L),y
         iny
         lda   bufaddrh
         sta   (A3L),y
         clc                            no errors possible
         rts

setbuf	equ	*-ofsX
         ldy   #$03
         jsr   alcbufr1			allocate new buffer address over old one
         bcs   L4EC7			report any errors immediately
         lda   bufaddrh
         sta   usrbuf+1
         lda   bufaddrl
         sta   usrbuf
         jsr   freebuf			free address space of old buffer
         ldy   #$00
         ldx   #$03
L4EB8    lda   (usrbuf),y               move all 4 pages of the buffer to
         sta   (datptr),y               new location.
         iny
         bne   L4EB8
         inc   datptr+1
         inc   usrbuf+1
         dex
         bpl   L4EB8
         clc                            no errors
L4EC7    rts


* move 3 pages of dispatcher from 'displc2' to 'dispadr'
* this move routine must be resident above $E000 at all times

calldisp equ	*-ofsX
         lda   altram			read/write RAM bank 2
         lda   altram
         lda   #>dispadr
         sta   A2L+1
         lda   #<dispadr
         sta   A2L
         lda   #>displc2
         sta   A1L+1
         stz   A1L
         ldy   #$00
         ldx   #$03			3 pages to move.
L4EE0    dey                            move a page of code.
         lda   (A1L),y
         sta   (A2L),y
         tya
         bne   L4EE0
         inc   A1L+1                    pointers to next page
         inc   A2L+1
         dex                            move all pages needed
         bne   L4EE0
         lda   ramin			read/write RAM bank 1
         lda   ramin                    swap mli space back in
         stz   mliact                   MLI active flag
         stz   softev                   
         lda   #>dispadr		point RESET to dispatch entry
         sta   softev+1
         eor   #$A5
         sta   pwredup                  power up byte
         jmp   dispadr

* translate a prodos call into a smartport call
* to access unseen smartport devices

remap_sp equ	*-ofsX
         ldx   #$03			assume 3 parameters.
         lda   A4L                      command number
         sta   cmdnum
         bne   L4F1B			taken if not status call
         ldy   #<spstatlist             set up memory for the status list buffer
         sty   buf			fake up the prodos parameters
         ldy   #>spstatlist
         sty   buf+1
         stz   bloknml			set statcode = 0 for simple status call
L4F1B    cmp   #$03                     format command ?
         bne   L4F21                    no.
         ldx   #$01                     format has only 1 parameter.
L4F21    stx   statparms		set # of parms.
         lda   unitnum                  
         lsr   a                        turn unit number into an index
         lsr   a
         lsr   a
         lsr   a
         tax
         lda   spunit-1,x               get the smartport unit number and
         sta   sp_unitnum		store into smartport parm list.
         lda   spvectlo-1,x	
         sta   sp_vector+1		copy smartport entry address
         lda   spvecthi-1,x
         sta   sp_vector+2
         ldx   #$04			copy buffer pointer and block #
L4F3F    lda   buf-1,x                  from prodos parameters
         sta   sp_bufptr-1,x            to smartport parameter block
         dex
         bne   L4F3F
sp_vector equ	*-ofsX                   smartport call
         jsr   $0000			(entry address gets modified)
cmdnum	equ	*-ofsX
	dc	h'00'			command #
         dc	i2'statparms'
         bcs	L4F6E
         ldx   cmdnum			status call ?
         bne   L4F6E                    no...
         ldx   spstatlist+1             else get the block count
         ldy   spstatlist+2
         lda	spstatlist		get the returned status.
         bit   #$10                     is there a disk present ?
         bne   L4F65                    yes, check for write protected.
         lda   #$2F                     return offline error.
         bra   L4F6D
L4F65    and   #$44                     mask all but write allowed and write
         eor   #$40                     protected bits. if allowed and not
         beq   L4F6E                    protected, exit with carry clear
         lda   #$2B                     else return write protected error.
L4F6D    sec
L4F6E    rts
spvectlo equ	*-ofsX			storage for low byte of smartport
         dc    h'0000000000000000'      entry.
         dc    h'00000000000000'
spvecthi equ	*-ofsX			storage for high byte of smartport
         dc    h'0000000000000000'      entry.
         dc    h'00000000000000'
statparms equ	*-ofsX			# of parms (always 3 except format)
	dc	h'03'
sp_unitnum equ	*-ofsX
         dc    h'00'                    unit number
sp_bufptr equ	*-ofsX
         dc	h'0000'			data buffer
         dc	h'000000'		block number (3 bytes)

* data tables

scnums	equ	*-ofsX			table of valid mli command numbers.
	dc	h'D3000000'
         dc    h'40410000808182'
         dc    h'65C0C1C2C3C4C5C6'
         dc    h'C7C8C9CACBCCCDCE'
         dc    h'CF00D0D1D2'
pcntbl	equ	*-ofsX			parameter counts for the calls
	dc	h'02FFFF'
         dc    h'FF0201FFFF030300'
         dc    h'04070102070A0201'
         dc    h'0103030404010102'
         dc    h'02FF020202'

* command table

cmdtable equ	*-ofsX
	dc	i2'create'		create
	dc	i2'destroy'		destroy
         dc    i2'rename'               rename
	dc	i2'setinfo'              setinfo
	dc	i2'getinfo'              getinfo
	dc	i2'online'               online
         dc    i2'setprefx'             set prefix
	dc	i2'getprefx'             get prefix
	dc	i2'openf'                open
	dc	i2'newline'              newline
         dc    i2'readf'                read
	dc	i2'writef'               write
	dc	i2'closef'               close
	dc	i2'flushf'               flush
         dc    i2'setmark'		set mark
	dc	i2'getmark'              get mark
	dc	i2'seteof'               seteof
	dc	i2'geteof'               geteof
         dc    i2'setbuf'               setbuf
	dc	i2'getbuf'               getbuf

* corresponding command function bytes

disptch	equ	*-ofsX
	dc	h'A0A1A2A3'
         dc    h'84050607'
         dc	h'88494A4B'
         dc    h'2C2D4E4F'
         dc    h'50515253'

dinctbl	equ	*-ofsX			table to increment
	dc	h'0100000200'           directory usage/eof counts
pass	equ	*-ofsX
	dc	h'75'
xdosver	equ	*-ofsX
	dc    h'00'
compat	equ	*-ofsX
         dc	h'00'
         dc	h'C3270D000000'
rootstuf equ	*-ofsX
         dc    h'0F02000400000800'
whichbit equ	*-ofsX
         dc    h'8040201008040201'
ofcbtbl	equ	*-ofsX
         dc    h'0C0D1819151617'
inftabl	equ	*-ofsX
         dc    h'1E101F2080939421'
         dc    h'22232418191A1B'
deathmsg equ	*-ofsX
	dc	h'20'
	msb	on
         dc    c'RESTART SYSTEM-$01'
	dc	h'20'

*** work space ***

* note: this area is accessed by code that depends on the order of these
*       variables in the file control block and temporary directory.

own_blk	equ	*-ofsX
         dc    h'0000'
own_ent	equ	*-ofsX
	dc	h'00'
own_len	equ	*-ofsX
	dc	h'00'
h_credt	equ	*-ofsX
	dc	h'0000'			directory creation date
	dc	h'0000'                  directory creation time
         dc    h'00'                    version under which this dir created
	dc	h'00'                    earliest version that it's compatible
h_attr	equ	*-ofsX                   attributes (protect bit, etc.)
	dc	h'00'
h_entln	equ	*-ofsX                   length of each entry in this directory
	dc	h'00'
h_maxent equ	*-ofsX                   maximum number of entries per block
	dc	h'00'
h_fcnt	equ	*-ofsX                   current # of files in this directory
	dc	h'0000'                  
h_bmap	equ	*-ofsX                   address of first allocation bitmap
         dc    h'0000'
h_tblk	equ	*-ofsX                   total number of blocks on this unit
	dc	h'0000'
d_dev	equ	*-ofsX                   device number of this directory entry
	dc	h'00'
d_head	equ	*-ofsX                   address of <sub> directory header
	dc	h'0000'                  
d_entblk equ	*-ofsX			address of block which contains entry
	dc	h'0000'
d_entnum equ	*-ofsX                   entry number within block
         dc    h'00'
d_stor	equ	*-ofsX
	dc	h'0000000000000000'      file name
        dc	h'0000000000000000'
d_filid	equ	*-ofsX                   user's identification byte
         dc    h'00'
d_frst	equ	*-ofsX                   first block of file
	dc	h'0000'
d_usage	equ	*-ofsX                   # of blocks allocated to this file
	dc	h'0000'
d_eof	equ	*-ofsX                   current end of file marker
	dc	h'000000'
d_credt	equ	*-ofsX
         dc    h'0000'                  file creation date
	dc	h'0000'			file creation time
d_sosver equ	*-ofsX			sos version that created this file
	dc	h'00'
d_comp	equ	*-ofsX                   backward version compatibility
	dc	h'00'
d_attr	equ	*-ofsX                   attributes (protect, r/w, enable, etc.)
	dc	h'00'
d_auxid	equ	*-ofsX                   user auxilliary identification
         dc    h'0000'
d_moddt	equ	*-ofsX
	dc	h'0000'                  file's last modification date
	dc	h'0000'                  file's last modification time
d_dhdr	equ	*-ofsX                   file directory header block address
	dc	h'0000'
scrtch	equ	*-ofsX			scratch area for
         dc    h'00000000'              allocation address conversion.
oldeof	equ	*-ofsX                   temp used in r/w
	dc	h'000000'
oldmark	equ	*-ofsX
         dc    h'000000'
xvcbptr	equ	*-ofsX                   used in 'cmpvcb' as a temp
	dc	h'00'
vcbptr	equ	*-ofsX
	dc	h'00'
fcbptr	equ	*-ofsX
	dc	h'00'
fcbflg	equ	*-ofsX
	dc	h'00'
reql	equ	*-ofsX
	dc	h'00'                    
reqh	equ	*-ofsX
	dc	h'00'
levels	equ	*-ofsX
         dc    h'00'
totent	equ	*-ofsX
	dc	h'00'
entcntl	equ	*-ofsX
	dc	h'00'
entcnth	equ	*-ofsX
	dc	h'00'
cntent	equ	*-ofsX
	dc	h'00'
nofree	equ	*-ofsX
	dc	h'00'
bmcnt	equ	*-ofsX
	dc	h'00'                    
saptr	equ	*-ofsX
	dc	h'00'
pathcnt	equ	*-ofsX
         dc    h'00'
p_dev	equ	*-ofsX
	dc	h'00'
p_blok	equ	*-ofsX
	dc	h'0000'
bmptr	equ	*-ofsX
	dc	h'00'
basval	equ	*-ofsX
	dc	h'00'
half	equ	*-ofsX
	dc	h'00'

* bitmap info tables

bmastat	equ	*-ofsX
	dc	h'00'
bmadev	equ	*-ofsX
         dc    h'00'
bmadadr	equ	*-ofsX
	dc	h'0000'
bmacmap	equ	*-ofsX
	dc	h'00'
tposll	equ	*-ofsX
	dc	h'00'
tposlh	equ	*-ofsX
	dc	h'00'
tposhi	equ	*-ofsX
	dc	h'00'
rwreql	equ	*-ofsX
	dc	h'00'
rwreqh	equ	*-ofsX
         dc    h'00'
nlchar	equ	*-ofsX
	dc	h'00'
nlmask	equ	*-ofsX
	dc	h'00'
ioaccess equ	*-ofsX			has a call been made to
	dc	h'00'                   disk device handler ?
cmdtemp	equ	*-ofsX
	dc	h'00'
bkbitflg equ	*-ofsX			used to set or clear backup bit
	dc	h'00'
duplflag equ	*-ofsX
	dc	h'00'
vcbentry equ	*-ofsX
	dc	h'00'

* xdos temporary variables

namcnt	equ	*-ofsX
         dc    h'00'
rnptr	equ	*-ofsX
	dc	h'00'
namptr	equ	*-ofsX
	dc	h'00'
vnptr	equ	*-ofsX
	dc	h'00'
prfxflg	equ	*-ofsX
	dc	h'00'
cferr	equ	*-ofsX
	dc	h'00'

* deallocation temporary variables

firstbl	equ	*-ofsX
	dc	h'00'
firstbh	equ	*-ofsX
	dc	h'00'
stortyp	equ	*-ofsX
         dc    h'00'
deblock	equ	*-ofsX
	dc	h'0000'
dtree	equ	*-ofsX
	dc	h'00'
dsap	equ	*-ofsX
	dc	h'00'
dseed	equ	*-ofsX
	dc	h'0000'
topdest	equ	*-ofsX
	dc	h'00'
dtmpx	equ	*-ofsX
	dc	h'00'
loklst	equ	*-ofsX			look list of recognized device numbers
dealbufl equ	*-ofsX
	dc	h'0000000000000000'
dealbufh equ	*-ofsX
         dc    h'0000000000000000'
cbytes	equ	*-ofsX
         dc    h'0000'
	dc	h'00'			cbytes+2 must = 0
bufaddrl equ	*-ofsX
	dc	h'00'                    
bufaddrh equ	*-ofsX
	dc	h'00'
goadr	equ	*-ofsX
	dc	h'0000'
delflag	equ	*-ofsX			used by 'detree' to know if called
         dc    h'00'                    from delete (destroy).

* zero fill to page boundary - 3 ($FEFD). so that cortland flag stays
* within page boundary.

	dc	h'00000000000000'	
        dc	h'0000000000'
         	
         dc	i2'calldisp'	
cortflag equ	*-ofsX			cortland flag. 1 = Cortland system
	dc	h'00'                    (must stay within page boundary)

* end of obj mli_2

* object code = ram_0
* /RAM driver (aux bank portion)
* this code is packed into $200 length with no room for expansion !!
* (see note at end of this obj)

* after the main /RAM routine has determined that the command is ok and the
* block to be read/written is within range, it transfers control to this 
* aux /RAM routine which remaps the block requested as follows:
*   request blocks 0,1: invalid
*                    2: returns VDIR (card block 3)
*                    3: returns BITMAP (synthesized)
*                    4: returns card block 0
*              $05-$5F: returns card blocks $05-$5F
*              $60-$67: returns blocks $68-$7F in bank 1 of language card
*              $68-$7F: returns blocks $68-$7F in bank 2 of language card

ofsR0	equ	ramsrc-ramdest		offset to /RAM driver org

ramsrc   lda   rd80col                  read 80 store
         pha                            save for later
         sta	store80off              turn off 80 store
         ldx   #$04                     move the parameters for use:
L5109    lda   A4L,x                    cmd, unit, bufptr and block (lo)
         sta   tcmd,x                   -> tcmd, tunit, R2L, R2H, R01
         dex
         bpl   L5109
         and   formatflg                format the volume first time
         bne   L514F                    thru, or when requested.
         ldx   bloknml			save R01 during format.
         lda   #>vblock1                block to be cleared.
         jsr   clrbuf1                  clears all buffers.
         ldy   #$03			format volume in 2 chunks.
L511F    lda   VDIR,y
         sta   vblock1+4,y
         dey
         bpl   L511F
         lda   #$FE			set last block as unusable
         sta   BITMAP+15                to protect vectors.
         tya                            set bitmap bits to $FF.
         ldy   #$0E                     15 bytes to set
L5130    sta   BITMAP,y
         dey
         bne   L5130
         sty   BITMAP                   first byte = 0.
         ldy   #$07                     do other chunk
L513B    lda   access,y
         sta   vblock1+34,y
         dey
         bpl   L513B
         lda   formatflg                if 0, set to $FF
         bne   L51AA                    else exitcard.
         sty   formatflg                y = $FF, won't format next time.
         stx   R01                      restore R01

* use the requested block number to determine
* which routine performs the transfer

L514F    asl   R01			block requested -> page requested.
         lda   R01                      get page requested.
         cmp   #$BF                     in language card ?
         bcs   L5163                    yes, do it.
         cmp   #$06                     bitmap ?
         bne   L5160
         jmp   tbmap                    yes, transfer bitmap
L5160    jmp   treg			else normal transfer.

* when a block between $60 and $7F is requested, it must be spirited into/from
* the language card area of the 64k card. this requires a 2 stage move:
* into the temp buffer and then to it's real destination.

L5163    tax				save R1 for later.
         jsr   setptr                   get direction
         php                            and save it.
         bcs   L51B8                    if it's a write.
lcrd	equ	*-ofsR0
         txa                            get R1 back
         cmp   #$CF                     which bank is it in ?
         bcs   L5173			in main bank.
         ora   #$10                     in secondary bank.
         bne   L5179                    branch always.
L5173    sta   altram			turn on main $D000
         sta   altram
L5179    sta   R01                      restore R1.
         lda   R2H                      save R2 for later
         pha
         ldx   R2L
         sta   setaltzp                 use alternate zero page/stack
         lda   #>dbuf                   set R2 to dbuf
         sta   R2H
         lda   #<dbuf
         sta   R2L
         jsr   setptr                   set pointers
         tay                            A > 0 from setptr
L5194    lda   (A1L),y                  move A1,A2 to A4,A3
         sta   (A4L),y
         lda   (A2L),y
         sta   (A3L),y
         dey
         bne   L5194
         sta   setstdzp                 use main zero page/stack
L51A2    stx   R2L
         pla                            restore R2
         sta   R2H
         plp                            get direction.
L51AA    bcs   L51B5                    write, done with move.
         sta   ramin			switch in MLI part of LC
         sta   ramin
         jsr   blockdo0			read, transfer dbuf to main
L51B5    jmp   exitcard
L51B8    jsr   blockdo0                 transfer main to dbuf.
         jmp   lcrd                     transfer dbuf to language card

* blockdo0 transfers a block between main memory and the 64k card. R1 contains
* the page address of the block in the card; R2 contains the page address of
* the block in main memory. the address in main memory is always in the
* language card, so the language card is always switched in. if cmd is 2, a
* write is done (R2->R1); if cmd is 1, a read is done (R1->R2).

blockdo0 equ	*-ofsR0			set up R1 = dbuf
         lda   #>dbuf
blockdo1 equ	*-ofsR0
         sta   R01
blockdo	equ	*-ofsR0
         jsr   setptr                   set pointers.
         bcs   L51DB                    it's a write.
         sta   wrmainram                transfer buffer directly to main.
         tay                            0 left from setptr.
L51CC    lda   (A1L),y                  transfer A1,A2 to A4,A3
         sta   (A4L),y
         lda   (A2L),y
         sta   (A3L),y
         dey
         bne   L51CC
         sta   wrcardram                back the way it was.
donewrt	equ	*-ofsR0			mainwrt returns here
         rts
L51DB    lda   #<mainwrt		pointers set up,
         sta   passit                   pass control to main ram
         lda   #>mainwrt
         jmp   ex1                    	set passit+1 and transfer

* setptr is used by other routines to set up pointers and dtect read or write

setptr	equ	*-ofsR0
         lda   tcmd			is it read or write ?
         lsr   a
         bcs   L5208                    taken if write.
         lda   R2H                      destination page
         sta   A4L+1
         sta   A3L+1
         lda   R2L
         sta   A4L
         sta   A3L
         lda   R01			source page
         sta   A1L+1
         sta   A2L+1
         lda   #$00                     source page aligned
         sta   A1L
         sta   A2L
         beq   L5223
L5208    lda   R2H			source page
         sta   A1L+1
         sta   A2L+1
         lda   R2L
         sta   A1L
         sta   A2L
         lda   R01			destination page
         sta   A4L+1
         sta   A3L+1
         lda   #$00			destination page aligned
         sta   A4L
         sta   A3L
L5223    inc   A2L+1
         inc   A3L+1
         rts

* tzip is called if blocks 0,1,4,5 are requested.
* on write it does nothing, on read it returns 0's.

tzip	jsr   clrbuf0			fill dbuf with 0's
         jsr   blockdo                  transfer the 0's
         jmp   exitcard                 and return

* clrbuf fills the buffer indicated by R01 to 0's.
* should only be called on a read or format.

clrbuf0	equ	*-ofsR0
         lda   #>dbuf			dbuf is temp buffer.
clrbuf1	equ	*-ofsR0
         sta   R01                      assign to block.
clrbuf2	equ	*-ofsR0
         jsr   setptr                   set pointers
         tay				acc = 0
L523A    sta   (A1L),y
         sta   (A2L),y
         dey
         bne   L523A
         rts

* treg maps the requested block into the aux card
* so that 8k data files will be contiguous (the index
* blocks will not be placed within data).

treg	equ	*-ofsR0
         cmp   #$04			page 4 = vdir
         bne   L524A                    not vdir, continue
         lda   #$07                     else transfer block 7
         bne   L5258
L524A    cmp   #$0F                     if any page < $F (block 8) requested,
         bcc   tzip                     it is invalid.
         ldx   #$00                     x = # of iterations.
         lda   bloknml                  use true block #.
         cmp   #$5D                     beyond 8k blocks ?
         bcc   L525B                    no, do normal
         sbc   #$50                     else subtract offset
L5258    jmp   times2                   and multiply by 2

* determine which 8k chunk it is in, place in x;
* block offset into chunk goes into y.

L525B    sec
         sbc   #$08			block=block-6
L525E    cmp   #$11                     if <=17 then done
         bcc   L5268
         sbc   #$11                     else block=block-17.
         inx                            iteration count.
         bpl   L525E                    should branch always
         dc    h'00'                    otherwise crash !!!
L5268    tay                            remainder in y

* if remainder is 1 then it's an index block:
* start index blocks at $1000,$2000...$19FF.
* if remainder is 0 then it is first data block
* in 8k chunk. page is 32 + (16 * x).
* otherwise, it is some other data block.
* page is 32 + (16 * x) + (2 * y)

         cpy   #$01			is it index block ?
         bne   L5273                    no.
         txa                            index = 2 * (8 + x)
         clc
         adc   #$08
         bne   L5285			multiply by 2.
L5273    inx                            iteration + 1.
         txa                            page = 2 * (16 + 8x)
         asl   a
         asl   a
         asl   a
         asl   a
         sta   R01
         tya                            get offset into 8k chunk
         beq   L5281                    if 0, no offset
         dey                            else offset = 2 * y
         tya
L5281    clc
         adc   R01
times2	equ	*-ofsR0                  
L5285    asl   a                        acc = 2 * acc
         jsr   blockdo1                 store in R01 and transfer
         jmp   exitcard                 and return

* when block 3 is requested, the bitmap is returned. the real bitmap is only
* 16 bytes long; the rest of the block is synthesized. the temporary buffer
* at $800 is used to build/read a full size bitmap block.

tbmap	equ	*-ofsR0
         lda   #>dbuf                   use temp buffer as block
         sta   R01
         jsr   setptr			set pointers, test read/write.
         bcs   L52A9                    branch if it's write.
         jsr   clrbuf2
         ldy   #$0F                     put real bitmap there
L529B    lda   BITMAP,y
         sta   (A1L),y
         dey
         bpl   L529B
         jsr   blockdo                  move temp buf to user buf
         jmp   exitcard
L52A9    jsr   blockdo                  move user buf to temp buf
         jsr   setptr
         ldy   #$0F                     move temp buf to bitmap.
L52B1    lda   (A4L),y                  (pointer set by setptr)
         sta   BITMAP,y
         dey
         bpl   L52B1
         jmp   exitcard

formatflg equ	*-ofsR0
         dc    h'00'			not formatted yet
tcmd	equ	*-ofsR0
        dc	h'00'			command
         dc	h'00'                    unit (not used)
R2L	equ	*-ofsR0
	dc	h'00'			R2 = user buffer
R2H	equ	*-ofsR0
         dc	h'00'
R01	equ	*-ofsR0
         dc	h'00'			page requested
BITMAP	equ	*-ofsR0
         dc	h'00FFFFFF'		blocks 0-7 used
         dc    h'FFFFFFFF'
         dc	h'FFFFFFFF'
         dc    h'FFFFFFFE'
VDIR	equ	*-ofsR0                  start of vdir.
	dc	h'F3'			storage type = F, name length = 3
	msb	off
         dc    c'RAM'
access	equ	*-ofsR0
         dc    h'C3'			destroy, rename, read enabled
         dc	h'27'                    entry length
         dc	h'0D'
         dc	h'0000'
         dc	h'0300'                  block 3
         dc	h'7F'                    128 blocks

exitcard equ	*-ofsR0
         lda   ramin			restore language card
         lda   ramin
         pla                            get 80store
         bpl   L52EA                    80store wasn't on
         sta   store80on                enable 80store
L52EA    jmp   bypass			jump around passit
passit	equ	*-ofsR0
         dc    h'0000'
bypass	equ	*-ofsR0
         lda   #<noerr			set up return to noerr
         sta   passit
         lda   #>noerr
ex1	equ	*-ofsR0
         sta   passit+1			also used by blockwrite
         clc                            transfer card to main
         clv                            use standard zeropage/stack
         jmp   xfer			jmp back from language card.

* NOTE: the previous section of code MUST NOT use $3FE or $3FF
*       since the interrupt vector must go there if aux interrupts
*       are to be used. no room for expansion here !!

         dc    h'0000'			$3FE-$3FF

* end of obj ram_0

* disk ii driver. object code = xrw_0

* critical timing requires page bound considerations for code and data.
* virtually the entire 'write' routine must not cross page boundaries.
* critical branches in the 'write', 'read', and 'read adr' subroutines
* which must not cross page boundaries are noted in comments.
* the cld at blockio must be present to determine bank of $D000
* $5300-5A00 moved to language card bank 1 at $D000

ofsD	equ	blockio-rwts		offset to disk ii driver org

blockio	cld				$D8 to flag language card bank 1 (main)
         jsr   rsetphse
         lda   q7l,x			turn off write enable
         nop
         nop
         jsr   docheck
         bcs   L5334			branch if block # is out of range
         ldy   #$05
L5310    asl   a
         rol	ibtrk
         dey
         bne   L5310
         asl   a
         bcc   L531C
         ora   #$10			adjust for upper 4 bits of track
L531C    lsr   a
         lsr   a
         lsr   a
         lsr   a
         pha				save sector # across call
         jsr   regrwts
         pla
         bcs   L5330			if error
         inc   buf+1
         adc   #$02
         jsr   regrwts			get 2nd half of block
         dec   buf+1
L5330    lda   ibstat
         rts	
L5334    lda   #$27			i/o error
         sec
         rts

* read/write a track/sector

regrwts	equ	*-ofsD
         ldy   #$01			retry count
         sty   seekcnt			only one recalibrate per call
         sta   ibsect
         lda   unitnum			get slot # for this operation
         and   #$70
         sta   A2L

* make sure other drives in other slots are stopped

         jsr   chkprev

* now check if the motor is on, then start it

         jsr   chkdrv
         php				save test results
         lda   #$E8
         sta   montimeh
         lda   unitnum			determine drive 1 or 2.
         cmp   iobpdn                   same drive used before ?
         sta   iobpdn                   save it for next time.
         php                            keep results of compare.
         asl   a                        get drive # into carry.
         lda   motoron,x                turn on the drive.
         bcc   L5362                    branch if drive 1 selected.
         inx                            select drive 2.
L5362    lda   drv0en,x
         plp                            was it the same drive ?
         beq   L5372                    yes.
         plp                            indicate drive off by setting z-flag.
         ldy   #$07                     150ms delay before stepping.
L536B    jsr   mswait
         dey
         bne   L536B
         php				now zero flag set.
L5372    lda   A4L                      make sure this command needs seeking.
         beq   L537C                    branch if status check.
         lda   ibtrk                    get destination track
         jsr   myseek                   and go to it.

* now at desired track. was the motor already on ?

L537C    plp				was motor on ?
         bne   L538E                    if so, don't wait.

* motor was off, wait for it to speed up

L537F    lda   #$01			wait 100us for each count in montime
         jsr   mswait
         lda   montimeh
         bmi   L537F                    count up to 0000

* motor should be up to speed,
* if it looks stopped then the drive is not present

         jsr   chkdrv			is drive present ?
         beq   hndlerr                  branch if no drive

* now check: if it is not the format disk command,
* locate the correct sector for this operation

L538E    lda   A4L			get command #
         beq   L53FD                    if 0 then status command
         lsr   a                        set carry = 1 for read, 0 for write.
         bcs   L5398                    must prenibblize for write
         jsr   prenib16
L5398    ldy   #$40			64 retries
         sty   retrycnt
L539D    ldx   A2L                      get slot #.
         jsr   rdadr16			read next address field.
         bcc   L53BE                    branch if read ok.
L53A4    dec   retrycnt                 one less chance.
         bpl   L539D                    branch to retry.
         lda   #$27                     anticipate a bad drive error.
         dec   seekcnt                  can only recalibrate once.
         bne   hndlerr
         lda   curtrk
         pha                            save track
         asl   a
         adc   #$10                     pretend track is 8 > curtrk
         ldy   #$40
         sty   retrycnt                 reset retries to 64 max.
         bne   L53CC                    always.

* have now read an address field. make sure this is
* the correct track, sector and volume.

L53BE    ldy   track			check track
         cpy   curtrk
         beq   L53D5                    ok

* recalibrating from this track

         lda   curtrk			preserve destination track
         pha
         tya
         asl   a
L53CC    jsr   settrk
         pla
         jsr   myseek
         bcc   L539D			always taken, go recalibrate

* drive is on right track, check volume mismatch

L53D5    lda   sect			is this the right sector ?
         cmp   ibsect
         bne   L53A4                    no, try another sector.
         lda   A4L                      read or write ?
         lsr   a                        the carry will tell.
         bcc   L53F4                    branch if write
         jsr   read16
         bcs   L53A4			if bad read
L53E7    lda   #$00
	dc	h'D0'			bne branch never taken (skip 1 byte)
hndlerr	sec
         sta   ibstat                   error #
         ldx   A2L                      slot offset
         lda   motoroff,x               turn off
         rts
L53F4    jsr   write16			write nibbles
statdne	equ	*-ofsD
         bcc   L53E7                    if no errors.
         lda   #$2B                     disk write protected.
         bne   hndlerr                  always
L53FD    ldx   A2L
         lda   q6h,x                    test for write protected
         lda   q7l,x
         rol   a                        write protect-->carry-->bit 0=1
         lda   q6l,x                    keep in read mode
         jmp   statdne
myseek	equ	*-ofsD
         asl   a			assume two phase stepper
         sta   track                    save destination track * 2
         jsr   alloff			turn all phases off to be sure.
         jsr   drvindx			get index to previous track
         lda   iobpdn,x                 for current drive.
         sta   curtrk                   current position.
         lda   track                    where to go next.
         sta   iobpdn,x
         jsr   seek			move head there
alloff	equ	*-ofsD
         ldy   #$03                     turn off all phases before returning.
L5427    tya                            (send phase in acc)
         jsr   clrphase			carry clear, phases should be turned off
         dey
         bpl   L5427
         lsr   curtrk			divide back down
         clc
         rts

* fast seek subroutine
*
* on entry:
*        x = slot# times $10
*      acc = desired half-track (single phase)
*   curtrk = current halftrack
*
* on exit:
*      a,y = uncertain
*        x = undisturbed
*      curtrk & trkn = final halftrack.
*              prior = prior halftrack if seek was required.
*      montimel,h are incremented by the # of 100us quantums required by
*                 seek for motor on time overlap.
*
* variables used: curtrk, trkn, countn, prior, A2L, montimel, montimeh

seek	equ	*-ofsD
         sta   trkn			save target track.
         cmp   curtrk                   on desired track ?
         beq   L5487                    yes, energize phase and return
         lda   #$00
         sta   trkcnt                   half track count.
L5440    lda   curtrk                   save curtrk for delayed turnoff
         sta   prior
         sec
         sbc   trkn                     delta-tracks.
         beq   L5483			branch if curtrk = destination
         bcs   mvout			move out, not in.
         eor   #$FF                     calculate tracks to go.
         inc   curtrk                   increment current track (in).
         bcc   L545A                    always taken.
mvout    adc   #$FE                     calculate tracks to go.
         dec   curtrk                   decrement current track (out).
L545A    cmp   trkcnt
         bcc   L5462                    and 'tracks moved'
         lda   trkcnt
L5462    cmp   #$09
         bcs   L5468                    if trkcnt > 8 then leave y alone (y=8)
         tay				else set acceleration index in y
         sec
L5468    jsr   setphase
         lda   ontable,y		for 'ontime'
         jsr   mswait                   (100us intervals)
         lda   prior
         clc                            for phaseoff
         jsr   clrphase                 turn off prior phase
         lda   offtable,y               then wait 'offtime'
         jsr   mswait                   (100us intervals)
         inc   trkcnt                   count of 'tracks moved'
         bne   L5440                    always taken
L5483    jsr   mswait                   settle 25 msec
         clc                            set for phase off
setphase equ	*-ofsD
L5487    lda   curtrk                   get current track
clrphase equ	*-ofsD
         and   #$03                     mask for 1 of 4 phases
         rol   a                        double for phaseon/off index
         ora   A2L
         tax
         lda   phaseoff,x		turn on/off one phase
         ldx   A2L                      restore x reg
         rts                            and return

* 7-bit to 6-bit 'deniblize' table (16-sector format)
*
* valid codes are $96 to $FF only. codes with more than one pair of
* adjacent zeroes or with no adjacent ones (except bit 7) are excluded.
*
* nibles in the ranges of $A0-$A3, $C0-$C7, $E0-$E3 are used for
* other tables since no valid nibles are in these ranges.

dnibl	equ	*-ofsD			aligned to page boundary minus $96
         dc    h'0004FFFF080CFF10'
         dc    h'1418'
twobit3	equ	*-ofsD			used in fast prenib as lookup for
         dc	h'008040C0FFFF'          2-bit quantities.
         dc    h'1C20FFFFFF24282C'
         dc    h'3034FFFF383C4044'
         dc    h'484CFF5054585C60'
         dc    h'6468'
twobit2	equ	*-ofsD			used in fast prenib.
         dc	h'00201030'
endmrks	equ	*-ofsD			table using 'unused' nibbles:
         dc	h'DEAAEBFF'              ($C4,$C5,$C6,$C7)
         dc    h'FFFFFF6CFF70'
         dc    h'7478FFFFFF7CFFFF'
         dc    h'8084FF888C909498'
         dc    h'9CA0'
twobit1	equ	*-ofsD			used in fast prenib.
         dc	h'0008040CFFA4'
         dc    h'A8ACFFB0B4B8BCC0'
         dc    h'C4C8FFFFCCD0D4D8'
         dc    h'DCE0FFE4E8ECF0F4'
         dc    h'F8FC'

* 6-bit to 2-bit conversion tables:
*
* dnibl2 abcdef-->0000FE
* dnibl3 abcdef-->0000DC
* dnibl4 abcdef-->0000BA

* origin = $D200 (page boundary)
* page align the following tables:

dnibl2	equ	*-ofsD
         dc	h'00'
dnibl3	equ	*-ofsD
         dc	h'00'
dnibl4	equ	*-ofsD
         dc	h'00'

* 6-bit to 7-bit nibl conversion table
*
* codes with more than one pair of adjacent zeroes
* or with no adjacent ones (except B7) are excluded.

nibl	equ	*-ofsD
         dc    h'960200'
         dc    h'00970100009A0300'
         dc    h'009B0002009D0202'
         dc    h'009E0102009F0302'
         dc    h'00A6000100A70201'
         dc    h'00AB010100AC0301'
         dc    h'00AD000300AE0203'
         dc    h'00AF010300B20303'
         dc    h'00B3000002B40200'
         dc    h'02B5010002B60300'
         dc    h'02B7000202B90202'
         dc    h'02BA010202BB0302'
         dc    h'02BC000102BD0201'
         dc    h'02BE010102BF0301'
         dc    h'02CB000302CD0203'
         dc    h'02CE010302CF0303'
         dc    h'02D3000001D60200'
         dc    h'01D7010001D90300'
         dc    h'01DA000201DB0202'
         dc    h'01DC010201DD0302'
         dc    h'01DE000101DF0201'
         dc    h'01E5010101E60301'
         dc    h'01E7000301E90203'
         dc    h'01EA010301EB0303'
         dc    h'01EC000003ED0200'
         dc    h'03EE010003EF0300'
         dc    h'03F2000203F30202'
         dc    h'03F4010203F50302'
         dc    h'03F6000103F70201'
         dc    h'03F9010103FA0301'
         dc    h'03FB000303FC0203'
         dc    h'03FD010303FE0303'
         dc    h'03FF'

* nibl buffer 'nbuf2' must be on a page boundary !!!

nbuf2	equ	*-ofsD			nibl buffer for read/write of low
	ds	86                       2-bits of each byte.
ibtrk	equ	*-ofsD
         dc    h'00'
ibsect	equ	*-ofsD
         dc	h'00'
ibstat	equ	*-ofsD
         dc	h'00'
iobpdn	equ	*-ofsD
	dc	h'00'
curtrk	equ	*-ofsD
         dc	h'00'
         dc	h'00000000000000'	for slots 1 thru 7
         dc    h'00000000000000'        drives 1 & 2
retrycnt equ	*-ofsD
         dc	h'00'
seekcnt	equ	*-ofsD
         dc	h'00'
trkcnt	equ	*-ofsD			halftracks moved count.
countn	equ	*-ofsD			'must find' count.
last	equ	*-ofsD                   'odd bit' nibls.
         dc	h'00'
csum	equ	*-ofsD			used for address header cksum
         dc	h'00'
csstv	equ	*-ofsD
         dc    h'00'
sect	equ	*-ofsD
         dc	h'00'
track	equ	*-ofsD
montimel equ	*-ofsD
         dc	h'00'
montimeh equ	*-ofsD			also 'volume'
         dc	h'00'
prior	equ	*-ofsD
         dc	h'00'
trkn	equ	*-ofsD
         dc	h'00'

* phase on, off time tables
* in 100 usec intervals (seek)

ontable	equ	*-ofsD
	dc	h'013028'
         dc    h'24201E1D1C1C'
offtable equ	*-ofsD
	dc	h'702C'
         dc    h'26221F1E1D1C1C'

* mswait subroutine
*
* delays a specified number of 100 usec intervals for motor timing.
* on entry: acc holds number of 100 usec intervals to delay.
* on exit: acc = 0, x = 0,  y = unchanged, carry set.
* montimel, montimeh are incremented once per 100 usec interval
* for motor on timing.

mswait	equ	*-ofsD
L5685    ldx   #$11			delay 86 usec
L5687    dex
         bne   L5687
         inc   montimel
         bne   L5692
         inc   montimeh
L5692    sec
         sbc   #$01
         bne   L5685
         rts

* read address field subroutine (16-sector format)
*
* reads volume, track and sector.
* on entry: x = slot# times $10, read mode (q6l,q7l)
* on exit: carry set if error, else if no error:
*          acc=$AA, y=0, x=unchanged, carry clear,
*          ccstv contains chksum,sector,track & volume read.
* uses temps: count,last,csum & 4 bytes at ccstv
* expects: original 10-sector normal density nibls (4-bit) odd bits then even.
* observe 'no page cross' warnings on some branches !!!

rdadr16	equ	*-ofsD
         ldy   #$FC
         sty   countn			'must find' count
L569D    iny
         bne   L56A5                    low order of count.
         inc   countn                   (2k nibles to find address mark
         beq   rderr                     else error)
L56A5    lda   q6l,x			read nibl
         bpl   L56A5                    *** no page cross ***
L56AA    cmp   #$D5                     address mark 1 ?
         bne   L569D
         nop                            nibl delay
L56AF    lda   q6l,x
         bpl   L56AF                    *** no page cross ***
         cmp   #$AA                     address mark 2 ?
         bne   L56AA                    if not, is it address mark 1 ?
         ldy   #$03                     index for 4 byte read
L56BA    lda   q6l,x
         bpl   L56BA                    *** no page cross ***
         cmp   #$96                     address mark 3 ?
         bne   L56AA                    if not, is it address mark 1
         sei                            no interrupts until address is tested.
         lda   #$00                     init checksum
L56C6    sta   csum
L56C9    lda   q6l,x                    read 'odd bit' nibl
         bpl   L56C9                    *** no page cross ***
         rol   a                        align odd bits, '1' into lsb.
         sta   last                     save them.
L56D2    lda   q6l,x                    read 'even bit' nibl
         bpl   L56D2                    *** no page cross ***
         and   last                     merge odd and even bits.
         sta   csstv,y                  store data byte.
         eor   csum
         dey
         bpl   L56C6                    loop on 4 data bytes.
         tay                            if final checksum non-zero,
         bne   rderr                    then error.
L56E6    lda   q6l,x                    first bit-slip nibl
         bpl   L56E6                    *** no page cross ***
         cmp   #$DE
         bne   rderr
         nop                            delay
L56F0    lda   q6l,x                    second bit-slip nible
         bpl   L56F0                    *** no page cross ***
         cmp   #$AA
         bne   rderr
         clc				normal read ok
         rts
rderr    sec
         rts

* read subroutine (16-sector format)
*
* reads encoded bytes into nbuf1 and nbuf2.
* first reads nbuf2 high to low, then nbuf1 low to high.
* on entry: x=slot# times $10, read mode (q6l,q7l)
* on exit: carry set if error, else if no error:
*          acc=$AA, x=unchanged, y=0, carry clear.
* observe 'no page cross' on some branches !!

read16	equ	*-ofsD
         txa				get slot #
         ora   #$8C                     prepare mods to read routine.
         sta   rd4+1                    warning: the read routine is
         sta   rd5+1                    self modified !!
         sta   rd6+1
         sta   rd7+1
         sta   rd8+1
         lda   buf                      modify storage addresses also
         ldy   buf+1
         sta   ref3+1
         sty   ref3+2
         sec
         sbc   #$54
         bcs   L571F			branch if no borrow
         dey
L571F    sta   ref2+1
         sty   ref2+2
         sec
         sbc   #$57
         bcs   L572B			branch if no borrow
         dey
L572B    sta   ref1+1
         sty   ref1+2
         ldy   #$20			32 tries to find
L5733    dey
         beq   L576D                    branch if can't find data header marks
L5736    lda   q6l,x
         bpl   L5736
L573B    eor   #$D5                     1st data mark
         bne   L5733
         nop                            delay
L5740    lda   q6l,x
         bpl   L5740
         cmp   #$AA                     2nd data mark.
         bne   L573B                    if not, check for 1st again
         nop
L574A    lda   q6l,x
         bpl   L574A
         cmp   #$AD                     3rd data mark
         bne   L573B                    if not, check for data mark 1 again
         ldy   #$AA
         lda   #$00
L5757    sta   pcl                      use z-page for keeping checksum
rd4	equ	*-ofsD
L5759    ldx   q6l+$60                  warning: self modified
         bpl   L5759
         lda   dnibl-$96,x
         sta   nbuf2-$AA,y              save the two-bit groups in nbuf.
         eor   pcl                      update checksum.
         iny                            next position in nbuf.
         bne   L5757                    loop for all $56 two-bit groups.
         ldy   #$AA                     now read directly into user buffer.
         bne   L5772                    always taken.
L576D    sec                            error
         rts
ref1	equ	*-ofsD
L576F    sta   $1000,y			warning: self modified
rd5	equ	*-ofsD
L5772    ldx   q6l+$60			warning: self modified
         bpl   L5772
         eor   dnibl-$96,x              get actual 6-bit data from dnib table.
         ldx   nbuf2-$AA,y              get associated two-bit pattern
         eor   dnibl2,x                 and combine to form whole byte.
         iny
         bne   L576F                    loop for $56 bytes.
         pha                            save for now, no time to store...
         and   #$FC                     strip low bits.
         ldy   #$AA                     prepare for next $56 bytes
rd6	equ	*-ofsD
L5788    ldx   q6l+$60                  warning: self modified
         bpl   L5788
         eor   dnibl-$96,x
         ldx   nbuf2-$AA,y
         eor   dnibl3,x
ref2	equ	*-ofsD
         sta   $1000,y			warning: self modified
         iny
         bne   L5788                    loop unil this group of $56 read
rd7	equ	*-ofsD
L579C    ldx   q6l+$60                  warning: self modified
         bpl   L579C
         and   #$FC
         ldy   #$AC			last group is $54 long
L57A5    eor   dnibl-$96,x
         ldx   nbuf2-$AC,y
         eor   dnibl4,x                 combine to form full byte
ref3	equ	*-ofsD
         sta   $1000,y			warning: self modified
rd8	equ	*-ofsD
L57B1    ldx   q6l+$60			warning: self modified
         bpl   L57B1
         iny
         bne   L57A5
         and   #$FC
         eor   dnibl-$96,x              checksum ok ?
         bne   L57CC                    error if not.
         ldx   A2L                      test end marks.
L57C2    lda   q6l,x
         bpl   L57C2
         cmp   #$DE
         clc
         beq   L57CD                    branch if good trailer
L57CC    sec
L57CD    pla                            place last byte into user buffer
         ldy   #$55
         sta   (buf),y
         rts

* set the slot dependent track location

settrk	equ	*-ofsD
         jsr   drvindx			get index to drive #
         sta   iobpdn,x
         rts

* determine if motor is stopped
*
* if stopped, controller's shift register will not be changing.
* return y = 0 and zero flag set if it is stopped.

chkdrv	equ	*-ofsD
         ldx   A2L
chkdrv0	equ	*-ofsD
         ldy   #$00			init loop counter.
L57DE    lda   q6l,x                    read the shift register.
         jsr   ckdrts			delay
         pha
         pla                            more delay.
         cmp   q6l,x                    has shift reg changed ?
         bne   L57F0                    yes, motor is moving.
         lda   #$28                     anticipate error.
         dey                            no, dec retry counter
         bne   L57DE                    and try 256 times.
ckdrts	equ	*-ofsD
L57F0    rts
drvindx	equ	*-ofsD
         pha                            preserve acc across call
         lda   A4L+1
         lsr   a
         lsr   a
         lsr   a
         lsr   a
         cmp   #$08
         and   #$07
         rol   a
         tax                            index to table.
         pla                            restore acc
         rts

* write subroutine (16 sector format)
*
* writes data from nbuf1 and buf. first nbuf2, high to low then direct
* from (buf), low to high. assumes 1 usec cycle time. self modified code !!
*
* on entry: x = slotnum times 16
*
* on exit: carry set if error (write protect violation).
*          if no error, acc=uncertain, x=unchanged, y=0, carry clear.

write16	equ	*-ofsD
         sec				anticipate write protect error
         lda   q6h,x
         lda   q7l,x                    sense write protect flag
         bpl   L580C
         jmp   wexit			exit if write protected

* timing is critical. a one micro-second cycle time is assumed.
* number in () is how many micro-seconds per instruction or subroutine

L580C    lda   nbuf2
         sta   pcl
         lda   #$FF         sync data.
         sta   q7h,x        (5) goto write mode
         ora   q6l,x        (4)
         ldy   #$04         (2) for five nibls
         nop                (2)
         pha                (3)
         pla                (4)
wsync    pha                (3) exact timing.
         pla                (4) exact timing.
         jsr   wnibl7       (13,9,6) write sync.
         dey                (2)
         bne   wsync        (3-) must not cross page !
         lda   #$D5         (2) 1st data mark
         jsr   wnibl9       (15,9,6)
         lda   #$AA         (2) 2nd data mark
         jsr   wnibl9       (15,9,6)
         lda   #$AD         (2) 3rd data mark
         jsr   wnibl9       (15,9,6)
         tya                (2) zero checksum
         ldy   #$56         (2) nbuf2 index
         bne   L583D        (3) branch always

* total time in this write byte loop must = 32us !!!

L583A    lda   nbuf2,y      (4) prior 6-bit nibl
L583D    eor   nbuf2-1,y    (5) xor with current
         tax                (2) index to 7-bit nibl
         lda   nibl,x       (4) must not cross page boundary
         ldx   A2L          (3) restore slot index
         sta   q6h,x        (5) store encoded byte
         lda   q6l,x        (4) handshake
         dey                (2)
         bne   L583A        (3-) must not cross page boundary

* end of write byte loop

         lda   pcl          (3) get prior nibl (from nbuf2)
wrefd1	equ	*-ofsD
         ldy   #$00         (2) warning: load value modified by prenib.
wrefa1	equ	*-ofsD
L5853    eor   $1000,y      (4) warning: address modified by prenib.
         and   #$FC         (2) strip low 2 bits
         tax                (2) index to nibl table
         lda   nibl,x       (4)
wrefd2	equ	*-ofsD
         ldx   #$60         (2) warning: value modified by prenib.
         sta   q6h,x        (5) write nibl
         lda   q6l,x        (4) handshake
wrefa2	equ	*-ofsD
         lda   $1000,y      (4) prior nibl. warning: address modified by prenib.
         iny                (2) all done with this page ?
         bne   L5853        (3-) loop until page end.
         lda   pch          (3) get next (precalculated & translated) nibl.
         beq   L58C0        (2+) branch if code written was page aligned.
         lda   A2H          (3) get byte address of last byte to be written.
         beq   L58B3        (2+) branch if only 1 byte left to write.
         lsr   a            (2) test for odd or even last byte (carry set/clear)
         lda   pch          (3) restore nibl to acc.
         sta   q6h,x        (5)
         lda   q6l,x        (4)
         lda   A1L          (3) = byte 0 of 2nd page xor'd with byte 1 if
         nop                (2) above test set carry.
         iny                (2) y=1
         bcs   L5899        (2+) branch if last byte to be odd.
wrefa3	equ	*-ofsD
L5881    eor   $1100,y      (4) warning: address modified by prenib.
         and   #$FC         (2) strip low 2 bits.
         tax	             (2) index to nibl table
         lda   nibl,x       (4) get nibl
wrefd3	equ	*-ofsD
         ldx   #$60         (2) restore slot index. warning: modified by prenib
         sta   q6h,x        (5)
         lda   q6l,x        (4)
wrefa4	equ	*-ofsD
         lda   $1100,y      (4) warning: modified by prenib
         iny                (2) got prior nibl, point to next
wrefa5	equ	*-ofsD
         eor   $1100,y      (4) warning: modified by prenib
L5899    cpy   A2H          (3) set carry if this is the last nibl
         and   #$FC         (2) strip low 2 bits
         tax                (2)
         lda   nibl,x       (4)
wrefd4	equ	*-ofsD
         ldx   #$60         (2) restore slot. warning: modified by prenib
         sta   q6h,x        (5)
         lda   q6l,x        (4)
wrefa6	equ	*-ofsD
         lda   $1100,y      (4) get prior nibl. warning: modified by prenib
         iny                (2)
         bcc   L5881        (3-) branch if not the last.
         bcs   L58B1        (3) waste 3 cycles, branch always.
L58B1    bcs   L58C0        (3) branch always.
L58B3    lda	|pch         (4) absolute reference to zero page
         sta   q6h,x        (5)
         lda   q6l,x        (4)
         pha                (3) waste 14 micro-seconds total
         pla                (4)
         pha                (3)
         pla                (4)
L58C0    ldx   A1H          (3) use last nibl (anded with $FC) for checksum
         lda   nibl,x       (4)
wrefd5	equ	*-ofsD
         ldx   #$60         (2) restore slot. warning: modified by prenib
         sta   q6h,x        (5)
         lda   q6l,x        (4)
         ldy   #$00         (2) set y = index end mark table.
         pha                (3) waste another 11 micro-seconds
         pla                (4)
         nop                (2)
         nop                (2)
L58D3    lda   endmrks,y    (4) dm4, dm5, dm6 and turn off byte.
         jsr   wnibl        (15,6) write it
         iny                (2)
         cpy   #$04         (2) have all end marks been written ?
         bne   L58D3        (3) if not.
         clc                (2,9)
wexit	equ	*-ofsD
         lda   q7l,x        out of write mode
         lda   q6l,x        to read mode.
         rts                return from write.

* 7-bit nibl write subroutines

wnibl9	equ	*-ofsD
         clc	            (2) 9 cycles, then write.
wnibl7	equ	*-ofsD
         pha                (3) 7 cycles, then write.
         pla                (4)
wnibl	equ	*-ofsD
         sta   q6h,x        (5) nibl write
         ora   q6l,x        (4) clobbers acc, not carry
         rts                (6)

* preniblize subroutine (16 sector format)
*
* converts 256 bytes of user data in (buf) into 6 bit nibls in nbuf2.
* high 6 bits are translated directly by the write routines.
*
* on entry: buf is 2-byte pointer to 256 bytes of user data.
*
* on exit: a,x,y undefined. write routine modified to do direct conversion
*          of high 6 bits of user's buffer data.

prenib16 equ	*-ofsD
         lda   buf			self-modify the addresses because of
         ldy   buf+1                    the fast timing required.
         clc                            all offsets are minus $AA.
         adc   #$02                     the highest set is buf+$AC.
         bcc   L58FA			branch if no carry,
         iny                            otherwise add carry to high address.
L58FA    sta   prn3+1                   self mod 3
         sty   prn3+2
         sec
         sbc   #$56			middle set is buf+$56.
         bcs   L5906                    branch if no borrow,
         dey                            otherwise deduct from high.
L5906    sta   prn2+1			self mod 2
         sty   prn2+2
         sec
         sbc   #$56			low set is exactly buf
         bcs   L5912
         dey
L5912    sta   prn1+1			self mod 1
         sty   prn1+2
         ldy   #$AA			count up to 0.
prn1	equ	*-ofsD                   get byte from lowest group.
L591A    lda   $1000,y			warning: self modified.
         and   #$03                     strip high 6 bits.
         tax                            index to 2 bit equivalent.
         lda   twobit1,x
         pha                            save pattern
prn2	equ	*-ofsD                   get byte from middle group.
         lda   $1056,y			warning: self modified.
         and   #$03
         tax
         pla                            restore pattern.
         ora   twobit2,x                combine 2nd group with 1st.
         pha                            save new pattern.
prn3	equ	*-ofsD                   get byte from highest group.
         lda   $10AC,y			warning: self modified.
         and   #$03
         tax
         pla                            restore new pattern
         ora   twobit3,x                and form final nibl.
         pha
         tya
         eor   #$FF
         tax
         pla
         sta   nbuf2,x                  save in nibl buffer.
         iny                            inc to next set.
         bne   L591A                    loop until all $56 nibls formed.
         ldy   buf                      now prepare data bytes for write16 subr.
         dey                            prepare end address.
         sty   A2H
         lda   buf
         sta   wrefd1+1			warning: the following storage addresses
         beq   L595F			starting with 'wref' are refs into code
         eor   #$FF                     space, changed by this routine.
         tay                            index to last byte of page in (buf).
         lda   (buf),y                  pre-niblize the last byte of the page
         iny                            with the first byte of the next page.
         eor   (buf),y
         and   #$FC
         tax
         lda   nibl,x                   get disk 7-bit nible equivalent.
L595F    sta   pch
         beq   L596F                    branch if data to be written is page
         lda   A2H                      aligned. check if last byte is even
         lsr   a                        or odd address. shift even/odd -> carry.
         lda   (buf),y			if even, then leave intact.
         bcc   L596D                    branch if odd.
         iny                            if even, then pre-xor with byte 1.
         eor   (buf),y
L596D    sta   A1L                      save result for write routine.
L596F    ldy   #$FF                     index to last byte of data to write.
         lda   (buf),y                  to be used as a checksum.
         and   #$FC                     strip extra bits
         sta   A1H                      and save it.
         ldy   buf+1			now modify address references to
         sty   wrefa1+2                 user data.
         sty   wrefa2+2
         iny
         sty   wrefa3+2
         sty   wrefa4+2
         sty   wrefa5+2
         sty   wrefa6+2
         ldx   A2L			and lastly, index references to
         stx   wrefd2+1                 controller.
         stx   wrefd3+1
         stx   wrefd4+1
         stx   wrefd5+1
         rts
chkprev	equ	*-ofsD
         eor   iobpdn			same slot as last ?
         asl   a
         beq   L59BD
         lda   #$01
         sta   montimeh
L59A6    lda   iobpdn
         and   #$70
         tax
         beq   L59BD                    branch if no previous ever (boot only).
         jsr   chkdrv0                  check if previous drive running.
         beq   L59BD                    branch if stopped.
         lda   #$01                     delay
         jsr   mswait
         lda   montimeh
         bne   L59A6
L59BD    rts
rsetphse equ	*-ofsD
         lda   unitnum			get unit number.
         and   #$7F                     mask off high bit.
         tax

* clear all the phases and force read mode

         lda   phaseoff+0,x		make sure all motor phases are off.
         lda   phaseoff+2,x
         lda   phaseoff+4,x
         lda   phaseoff+6,x
         rts
docheck	equ	*-ofsD
         lda   A4L			command #.
         cmp   #$04                     is the command allowed ?
         bcs   L59E6                    if not.
         lda   bloknml
         ldx   bloknml+1
         stx   ibtrk                    calculate block's track and sector.
         beq   L59E8                    branch if block # is in range,
         dex                            else test further.
         bne   L59E6                    taken if bad range.
         cmp   #$18                     must be < $118
         bcc   L59E8                    then ok.
L59E6    sec                            error.
         rts
L59E8    clc
         rts				end of obj xrw_0

         dc    h'0000'			pad bytes to $D6EC (pathbuf-$14)

* variables used by mli for smartport interface

spstatlist equ	*-ofsD			ref pathbuf-$14
	dc	h'00000000'		smartport status list buffer
spunit	equ	*-ofsD			ref pathbuf-$10
         dc    h'0000000000000000'	smartport unit numbers
         dc    h'0000000000000000'

* pathname buffer starts at this page boundary (pathbuf = $D700)

* object code = sel_0
*
* dispatcher 1 - this code org's and operates at 'dispadr' (=$1000) but
* is resident in memory at 'displc2' (=$D100) in the alternate 4k bank
* of the language card. the quit call vectors to a routine high in the
* mli that moves dispatcher 1 down and jumps to it. the move routine
* must remain somewhere between $E000-$F7FF. this routine must be less
* than 3 pages in length.

ofsS	equ	disp1obj-dispadr	offset to dispatcher org

disp1obj lda   romin			read ROM
         sta   clr80vid                 disable 80 col hardware
         sta   clraltchar               normal LC, flashing UC
         sta	store80off		disable 80 column store
         jsr   setnorm                  set normal text mode
         jsr   init                     init text screen
         jsr   setvid                   reset output to screen
         jsr   setkbd                   reset input to keyboard
         ldx   #$17			clear the memory bitmap
         lda   #$01                     but protect page $BF00.
         sta   memmap,x                 P8 memory bitmap
         dex
         lda   #$00
L5A22    sta   memmap,x
         dex
         bpl   L5A22
         lda   #$CF                     protect zero page, stack and
         sta   memmap                   $400-$7FF (text screen display)
L5A2D    jsr   home                     clear screen
         jsr   crout                    position top/left
         ldx   #<dsp1msg0-dsp1msgs
         jsr   prntmsg			'enter prefix...'
         lda   #$03                     line 3
         sta   cv
         jsr   crout
         jsr   prodos8                  get prefix
         dc    i1'$C7'
         dc    i2'dsp1pfx'
         ldx   pbuf                     get prefix length
         lda   #$00                     put 0 at end of prefix
         sta   pbuf+1,x
         ldx   pbuf                     get length.
         beq   L5A5D                    if no prefix to display.
L5A52    lda   pbuf,x			display prefix directly to screen
         ora   #$80                     normal text
         sta   vline5-1,x               line 5
         dex
         bne   L5A52
L5A5D    ldx   #$00
         dec   cv
         jsr   crout
getkey	equ	*-ofsS
         jsr   rdkey                    input char with cursor
         cmp   #$8D			cr ?
         beq   L5ABD                    yes, accept what is entered.
         pha                            no, save the char.
         jsr   clreol                   clear rest of line.
         pla                            get char back
         cmp   #$9B                     esc ?
         beq   L5A2D                    yes, start over
         cmp   #$98                     ctrl-x ?
L5A76    beq   L5A2D                    then start over
         cmp   #$89                     tab ?
         beq   badkey
         cmp   #$FF                     delete ?
         beq   L5A84                    if yes
         cmp   #$88                     backspace ?
         bne   L5A91                    if not
L5A84    cpx   #$00                     at column 0 ?
         beq   L5A8B                    if so, do nothing
         dec   ch                       else move left
         dex                            dec char count
L5A8B    jsr   clreol                   clear rest of line
         jmp   getkey                   get another char
L5A91    bcs   L5A99
badkey	jsr   bell                     output bell for bad key
         jmp   getkey                   and get another.
L5A99    cmp   #$DB                     below 'Z' ?
         bcc   L5A9F                    if yes
         and   #$DF                     else shift to uppercase.
L5A9F    cmp   #$AE                     below '.' ?
         bcc   badkey
         cmp   #$DB                     above 'Z' ?
         bcs   badkey
         cmp   #$BA                     below ':' ?
         bcc   goodkey
         cmp   #$C1			at or above 'A' ?
         bcc   badkey
goodkey  inx
         cpx   #$27                     more than 39 chars ?
         bcs   L5A76                    then too many, go restart.
         sta   pbuf,x                   save it
         jsr   cout
         jmp   getkey                   get another.
L5ABD    cpx   #$00                     prefix length = 0 ?
         beq   L5AD3                    if yes, don't set length.
         stx   pbuf                     set prefix length.
         jsr   prodos8			call mli to set prefix.
         dc    i1'$C6'
         dc    i2'dsp1pfx'
         bcc   L5AD3                    if ok, go get filename.
         jsr   bell			if not, ring bell
         lda   #$00                     and try again for prefix.
L5AD1    beq   L5A76
L5AD3    jsr   home			clear screen for application name.
         jsr   crout
         ldx   #<disp1msg-dsp1msgs
         jsr   prntmsg			'enter pathname...'
retryrich equ	*-ofsS
         lda   #$03                     line 3
         sta   cv
         jsr   crout
         ldx   #$00
loop1	equ	*-ofsS
         jsr   rdkey                    input char with cursor.
         cmp   #$9B                     esc ?
         bne   L5AF4                    if not esc.
         lda   ch			esc pressed in column 0 ?
         bne   L5AD3                    if not, get pathname again.
         beq   L5AD1                    if so, get prefix again.
L5AF4    cmp   #$98                     ctrl-x ?
L5AF6    beq   L5AD3                    then cancel and get pathname again.
         cmp   #$89                     tab ?
         beq   L5B09                    not good.
         cmp   #$FF                     delete ?
         beq   L5B04                    delete char.
         cmp   #$88                     backspace ?
         bne   L5B07
L5B04    jmp   delchar			delete char.
L5B07    bcs   L5B0F                    if > $88 then char may be acceptable.
L5B09    jsr   bell                     output bell (ctl-G)
         jmp   loop1			not good.
L5B0F    cmp   #$8D                     cr ?
         beq   L5B3C                    then done.
         cmp   #$DB                     less than 'Z' ?
         bcc   L5B19                    no.
         and   #$DF                     make sure it's uppercase.
L5B19    cmp   #$AE                     '.' ?
         bcc   L5B09                    not good if less.
         cmp   #$DB                     less than '[' ?
         bcs   L5B09                    not good.
         cmp   #$BA                     <= '9' ?
         bcc   L5B29                    then ok.
         cmp   #$C1                     greater than 'A' ?
         bcc   L5B09                    if not, then no good.
L5B29    pha                            it's good, save it.
         jsr   clreol                   clear to end of line
         pla
         jsr   cout			print it
         inx
         cpx   #$27                     more than 39 chars ?
         bcs   L5AF6                    too long, get pathname again.
         sta   pbuf,x                   store it.
         jmp   loop1                    get another char
L5B3C    lda   #$A0
         jsr   cout                     after cr, blank out the cursor.
         stx   pbuf                     put length in front of the name.
         jsr   prodos8                  get file info for pathname in pbuf
         dc    i1'$C4'
         dc    i2'dsp1info'
         bcc   L5B4F                    if no errors.
         jmp   dsp1error
L5B4F    lda   dsp1type
         cmp   #$FF                     is it a SYS file ?
         beq   L5B5B                    yes.
         lda   #$01                     not SYS file error.
         jmp   dsp1error
L5B5B    lda   #$00                     it's a system file
         sta   dsp1cln
         jsr   prodos8                  close all open files
         dc    i1'$CC'
         dc    i2'dsp1cls'
         bcc   L5B6B
         jmp   dsp1error
L5B6B    lda   dsp1acess		check for proper access.
         and   #$01                     is read disabled ?
         bne   L5B77                    no, access ok.
         lda   #$27                     i/o error
         jmp   dsp1error
L5B77    jsr   prodos8                  open the file
         dc    i1'$C8'
         dc    i2'dsp1open'
         bcc   L5B82
         jmp   dsp1error
L5B82    lda   dsp1refn                 copy the reference number
         sta   dsp1rdn
         sta   dsp1eofn
         jsr   prodos8                  get eof
         dc    i1'$D1'
         dc    i2'dsp1eof'
         bcs   L5BE2
         lda   dsp1eofb+2               3rd of 3 bytes.
         beq   L5B9C                    if 0 then ok
         lda   #$27                     else i/o error because
         bne   L5BE2                    file is too large.
L5B9C    lda   dsp1eofb                 move eof to # of bytes to read.
         sta   dsp1cnt
         lda   dsp1eofb+1
         sta   dsp1cnt+1
         jsr   prodos8                  read the file
         dc    i1'$CA'
         dc    i2'dsp1read'
         php				save the status.
         jsr   prodos8                  close the file.
         dc    i1'$CC'
         dc    i2'dsp1cls'
         bcc   L5BBB	
L5BB7    plp                            get status (it is irrelevant now)
         bne   L5BE2                    if close generated an error
         plp                            here if close was ok.
L5BBB    bcs   L5BB7                    error.
         jmp   sysentry                 execute system file
delchar	equ	*-ofsS
         lda   ch			is cursor in column 0 ?
         beq   L5BD3                    yes, ignore it.
         dex
         lda   #$A0                     blank out the cursor
         jsr   cout
         dec   ch
         dec   ch                       point to last char entered
         jsr   cout                     and blank it too.
         dec   ch			point to that location.
L5BD3    jmp   loop1                    get next char.
prntmsg	equ	*-ofsS
L5BD6    lda   dsp1msgs,x
         beq   L5BE1
         jsr   cout
         inx
         bne   L5BD6
L5BE1    rts

* dispatcher 1 error handler

dsp1error equ	*-ofsS
L5BE2    sta   errnum
         lda   #$0C			display error message on line 13
         sta   cv
         jsr   crout
         lda   errnum
         cmp   #$01
         bne   L5BF5
         ldx   #<dsp1err1-dsp1msgs	not a type 'sys' file
         bne   L5C0B                    handled separately.
L5BF5    cmp   #$40			syntax error in pathname ?
         beq   L5C09
         cmp   #$44                     bad subdirectory path ?
         beq   L5C09
         cmp   #$45                     volume not found ?
         beq   L5C09
         cmp   #$46                     file not found ?
         beq   L5C09
         ldx   #<dsp1err2-dsp1msgs      if not the errors above then 'i/o error'
         bne   L5C0B                   
L5C09    ldx   #<dsp1err3-dsp1msgs      otherwise display 'file/path not found'
L5C0B    jsr   prntmsg
         jmp   retryrich                retry for application pathname
	msb	on
dsp1msgs equ	*-ofsS
dsp1msg0 equ	*-ofsS
         dc    c'ENTER PREFIX (PRESS "RETURN" TO ACCEPT)'
         dc    h'00'
disp1msg equ	*-ofsS
         dc    c'ENTER PATHNAME OF NEXT APPLICATION'
         dc    h'00'
dsp1err1 equ	*-ofsS
         dc    h'87'
         dc    c'NOT A TYPE "SYS" FILE'
         dc    h'00'
dsp1err2 equ	*-ofsS
         dc    h'87'
         dc    c'I/O ERROR            '
         dc    h'00'
dsp1err3 equ	*-ofsS
         dc    h'87'
         dc    c'FILE/PATH NOT FOUND  '
         dc    h'00'
dsp1info equ	*-ofsS			get file info parms
         dc    h'0A'                    10 parameters
         dc	i2'pbuf'                 pathname buffer
dsp1acess equ	*-ofsS
         dc	h'00'			access
dsp1type equ	*-ofsS
         dc	h'00'			file type
         ds	13			the rest are unimportant
dsp1open equ	*-ofsS                   open file parms
	dc	h'03'			3 parameters for open
         dc	i2'pbuf'                 pathname buffer
         dc	i2'fbuf'		fcb buffer
dsp1refn equ	*-ofsS
	dc	h'00'                    reference #
dsp1cls	equ	*-ofsS			close file parms
         dc    h'01'                    1 parameter for close
dsp1cln	equ	*-ofsS
         dc	h'00'			reference #
dsp1read equ	*-ofsS
	dc	h'04'			4 parameters for read
dsp1rdn	equ	*-ofsS
         dc	h'00'			reference #
         dc	i2'sysentry'		.SYS load address
dsp1cnt	equ	*-ofsS
	dc	h'0000'			byte count
         dc    h'0000'
dsp1eof	equ	*-ofsS			get eof parms
	dc	h'02'			2 parameters
dsp1eofn equ	*-ofsS
	dc	h'00'                    reference #
dsp1eofb equ	*-ofsS
	dc	h'000000'		3 byte eof
dsp1pfx	equ	*-ofsS                   get/set prefix parms
         dc    h'01'			1 parameter
         dc	i2'pbuf'                 prefix buffer

disp1end equ	*
	ds	$300-(disp1end-disp1obj)	fill to page boundary

* end of obj sel_0

* object code = sel_1
* Bird's Better Bye at org = dispadr

ofsB	equ	birdbye-dispadr		offset to Bird's Bye org

birdbye	cld
         lda   romin			read ROM
         stz   softev
         lda   #>dispadr		set reset vector to 'dispadr'
         sta   softev+1                 
         jsr   setpwrc                  create power-up byte
         lda   #$A0
         jsr   init80                   initialize 80 column text card
         ldx   #$17

* set up memory bitmap in global page

L5D16    stz   memmap,x                 P8 memory bitmap
         dex
         bpl   L5D16
         inc   memmap+$17		protect global page
         lda   #$CF			protect zero page, stack and page 1
         sta   memmap
         lda   #$02
         sta   smparms			init set mark parms pcount.

* drive selector

         ldx   numdevs                  get device count and
         stx   lstpntr                  store in zero page.
         lda   devnum                   get last slot/drive
         bne   volname
ds2	equ	*-ofsB
L5D32    ldx   lstpntr			get device list pointer.
         lda   devlist,x                get unit number from list.
         cpx   #$01                     make sure it's real.
         bcs   L5D3F                    if so, change list pointer.
         ldx   numdevs                  get device count.
         inx
L5D3F    dex                            decrement list pointer and restore.
         stx   lstpntr

* get and store volume name

volname	sta   ol_unit			store unit number for online.
         jsr   prodos8
         dc    i1'$C5'			online call
         dc    i2'ol_parms'
         bcs   L5D32                    error check.
         stz   dlevel                   haven't read root directory yet.
         lda   pbuf+1			load description byte.
         and   #$0F                     mask for name length.
         beq   L5D32                    if 0, then try next unit.
         adc   #$02                     add 2 to length.
         tax                            name length in x.
vnam1	equ	*-ofsB
         stx   pbuf			save the name length
         lda   #$2F                     '/'
         sta   pbuf+1                   slash before and
         sta   pbuf,x                   after name.
         stz   pbuf+1,x                 null after complete name.

* open and read directory

         jsr   prodos8                  
         dc    i1'$C8'                  open
         dc    i2'op_parms'
         bcc   L5D7F			good open.
         lda   dlevel                   trying to open root directory ?
         beq   L5D32                    yes, just move to next volume.
         jsr   bell1                    no, generate bell tone
         jsr   popdir			and stay at same level.
         stx   pbuf
         jmp   keyloop
L5D7F    inc   dlevel
         stz   filecount		zero file count.
         lda   op_refn			get file reference number
         sta   rd_refn			store in read
         sta   sm_refn                  and setmark parm lists.
         lda   #$2B                     set read parm list for
         sta   dhdr_len                 directory header length.
         stz   dhdr_len+1
         jsr   doread			read directory
         bcs   L5DB3
         ldx   #$03
L5D9A    lda   sysentry+$23,x		copy directory info
         sta   entlen,x                 to zero page.
         dex
         bpl   L5D9A
         sta   dhdr_len                 put entry length in read parm list.
         lda   #$01                     set block file counter to 1.
         sta   blkfl
         stz   fpos_mid                 zero out msb's of file position
         stz   fpos_hi                  in setmark parm list.
         lda   filecnt                  any files in directory ?
         ora   filecnt+1
         bne   L5DB5                    if so, continue
L5DB3    bra   L5E29                    else go close directory file.
L5DB5    bit   filecnt+1                check msb of file count.
         bmi   L5DB3                    if set then done.
L5DB9    lda   fpos_mid                 get mid byte of setmark file position.
         and   #$FE                     reset lsb
         sta   fpos_mid                 and save.
         ldy   blkfl                    block file counter
         lda   #$00
         cpy   entblk                   have we read all entries in this block ?
         bcc   L5DCE			if not, continue.
         tay                            if so, zero y-reg and
         sty   blkfl                    reset block counter / flag
         inc   fpos_mid

* set up setmark parameters for next file to be read.
* if transfer to second sector, handle it.

L5DCC    inc   fpos_mid
L5DCE    dey				decrement file block counter
         clc
         bmi   L5DD8
         adc   entlen                   add entry length to acc.
         bcc   L5DCE                    determine if we flopped into 2nd half of
         bcs   L5DCC			block, if so inc mid byte position.
L5DD8    adc   #$04			add 4 and put in
         sta   fpos_lo                  low byte of setmark.
         jsr   prodos8                  call mli
         dc    i1'$CE'                  set mark
         dc    i1'smparms'		parameters address = $0060
         dc	h'00'
         bcs   L5DB3			error
         jsr   doread
         bcs   L5DB3                    error.
         inc   blkfl                    increase count of files read.
         lda   sysentry			file type/length.
         and   #$F0                     mask off high nibble.
         beq   L5DB9                    deleted file, try next one.
         dec   filecnt                  decrement low file count.
         bne   L5DF8
         dec   filecnt+1                and high if necessary.
L5DF8    ror   sysentry+$1E		check access bit.
         bcc   L5DB5                    if no read, try next file.
         lda   sysentry+$10		get file type.
         cmp   #$0F                     directory file ?
         beq   L5E08                    then continue.
         cmp   #$FF                     system file ?
         bne   L5DB5                    no, read next file.
L5E08    ldx   filecount                get valid files read.
         cpx   #$80                     if greater than size of filename buffer
         bcs   L5E29                    then close directory
         sta   filetyps,x               else store filetype in zero page
         jsr   namecalc                 and go set up storage area.
         ldy   #$0F
L5E15    lda   sysentry,y		get byte of filename
         sta   (fnstore),y              store in directed area
         dey
         bpl   L5E15
         iny                            y = 0
         and   #$0F                     mask off low nibble (name length)
         sta   (fnstore),y              restore in name buffer
         inc   filecount                increment valid file counter
         bne   L5DB5                    get next file (branch always)
L5E26    jmp   ds2                      error. try next unit.
L5E29    jsr   prodos8                  close directory file
         dc    i1'$CC'
         dc    i2'cl_parms'
         bcs   L5E26	error.
         jsr   settxt                   use full screen for windows
         jsr   home
         lda   #$17                     cursor at bottom of screen.
         jsr   tabv			set vertical position.
         ldy   #$00
         lda   #$14                     horizontal position.
         jsr   sethorz			print message.
         jsr   homecurs                 cursor to upper/left.
         ldx   #$00
L5E48    lda   pbuf+1,x
         beq   showfiles
         jsr   output
         inx
         bne   L5E48
showfiles stz	valcnt
         stz   topname			init top filename index.
         lda   filecount                # of valid files.
         beq   L5EB0                    if no files.
         cmp   #$15                     more than what will fit on screen ?
         bcc   L5E61                    no.
         lda   #$14                     limit to 20 files on the screen.
L5E61    sta   gp_cnt
         lda   #$02			set window dimensions
         sta   wndtop
         sta   wndlft
         lda   #$16
         sta   wndwdth
         sta   wndbtm
L5E6F    jsr   nameprnt			output filename to screen
         inc   valcnt
         dec   gp_cnt                   file counter.
         bne   L5E6F                    continue printing names.
         stz   valcnt
         beq   L5EAA                    if last file, it needs to be inverse.
uparrow	jsr	nameprnt		print old name in normal.
         ldx   valcnt                   get old name number.
         beq   L5EAA                    if already at the top name
         dec   valcnt                   else fix index.
         lda   cv                       current cursor line.
         cmp   #$02                     at top line of window ?
         bne   L5EAA                    no, move up normally.
         dec   topname                  fix offset index
         lda   #$16                     else sroll windows down a line.
         bne   L5EA7                    branch always.
dnarrow	jsr	nameprnt		print old name in normal.
         ldx   valcnt                   get old name number.
         inx                            add one.
         cpx   filecount
         bcs   L5EAA                    if already at last filename
         stx   valcnt                   else update index.
         lda   cv                       current cursor line.
         cmp   #$15                     at bottom line of window ?
         bne   L5EAA                    no, move cursor normally.
         inc   topname                  update offset index
         lda   #$17                     else scroll up a line.
L5EA7    jsr   cout
L5EAA    jsr   setinv                   set inverse text mode.
         jsr   nameprnt			output last filename.
keyloop	equ	*-ofsB
L5EB0    lda   kbd                      get keyboard input.
         bpl   L5EB0                    loop until key pressed.
         sta   kbdstrobe                clear strobe.
         jsr   setnorm                  set normal text mode.
         ldx   filecount                are any files displayed ?
         beq   L5ECB                    no, don't accept arrow keys or return.
         cmp   #$8D                     return ?
         beq   L5EF4                    then run selected file.
         cmp   #$8A                     down ?
         beq   dnarrow                  move down a name.
         cmp   #$8B                     up ?
         beq   uparrow                  move up a name.
L5ECB    cmp   #$89                     tab ?
         beq   L5EED                    new volume.
         cmp   #$9B                     esc ?
         bne   L5EB0                    no, try again else pop up a directory.

* pop a directory level

         jsr   popdir
         dec   dlevel
         bra   L5EF1
popdir	equ	*-ofsB
         ldx   pbuf
L5EDD    dex
         lda   pbuf,x
         cmp   #$2F	slash
         bne   L5EDD
         cpx   #$01
         bne   L5EEC
         ldx   pbuf
L5EEC    rts
L5EED    jmp   ds2			set up new unit number.
L5EF0    inx
L5EF1    jmp   vnam1                    get new directory info.

* run selected file

L5EF4    jsr   prodos8                  set prefix
         dc    i1'$C6'
         dc    i2'pf_parms'
         bcs   L5EED	error.
         ldx   valcnt                   get name number.
         jsr   namecalc                 set up name storage area (on return y=0)
         ldx   pbuf                     get prefix length.
L5F04    iny                            start at y = 1.
         lda   (fnstore),y              get character of name.
         inx
         sta   pbuf,x                   store in prefix buffer.
         cpy   namelen                  check length of name.
         bcc   L5F04                    loop until all transferred.
         stx   pbuf                     put prefix length into buffer.
         ldy   valcnt                   get file number.
         lda	|filetyps,y		get file type.
         bpl   L5EF0                    branch if directory.
         jsr   settxt                   reset to full window.
         jsr   home                     makes for no flash.
         lda   #$95                     ctrl-u
         jsr   cout                     turn off 80 columns.
         jsr   prodos8                  open file
         dc    i1'$C8'
         dc    i2'op_parms'
         bcs   L5EED                    if error.
         lda   op_refn                  move reference number
         sta   rd_refn                  for read.
         lda   #$FF                     read the entire file.
         sta   dhdr_len
         sta   dhdr_len+1
         jsr   doread                   read selected file.
         php                            save possible error.
         jsr   prodos8                  close file. ignore any error from close
         dc    i1'$CC'
         dc    i2'cl_parms'
         plp                            restore status from read.
         bcs   L5EED                    if any errors.
         jmp   sysentry			execute selected system file.

* output messages. on entry: acc = horizontal position,
* y = index to message teminated by 0.

sethorz	equ	*-ofsB
         sta   ch
msgout	equ	*-ofsB
L5F4C    lda   dsp2msg,y
         beq   L5F57
         jsr   cout
         iny
         bne   L5F4C
L5F57    rts

* name pointer calculator for name storage area

namecalc equ	*-ofsB
         stz   fnstore+1		init high byte of 16-bit shift
         txa
         asl   a                        shift to high nibble
         rol   fnstore+1
         asl   a
         rol   fnstore+1
         asl   a
         rol   fnstore+1
         asl   a
         rol   fnstore+1
         sta   fnstore			low pointer
         lda   #>iobuf
         clc
         adc   fnstore+1
         sta   fnstore+1
         ldy   #$00
         lda   (fnstore),y		file name length
         sta   namelen
         rts

* output a filename line

nameprnt equ	*-ofsB
         lda   #$02
         sta   ch80col			horizontal position = 2.
         ldx   valcnt                   filename number
         txa
         sec
         sbc   topname                  calculate line # to display name
         inc   a
         inc   a
         jsr   tabv			set vertical position.
         lda   filetyps,x               get filetype (x is unchanged by tabv).
         bmi   L5F99                    branch if system file.
         stz   ch80col                  adjust cursor position.
         lda   invflg			save current inverse setting
         pha
         ldy   #<fldrmsg-dsp2msg
         jsr   msgout                   display the folder.
         pla                            restore inverse setting.
         sta   invflg
L5F99    jsr   outsp			output a space.
         jsr   namecalc                 calc name location.
L5F9F    iny                            y = 1 (first time).
         lda   (fnstore),y              get name character.
         jsr   output                   put on screen.
         cpy   namelen                  end of name ?
         bcc   L5F9F                    no.
outsp	equ	*-ofsB                   output a space.
         lda   #$A0
         bne   L5FB1                    branch always.
homecurs equ	*-ofsB                   screen control - home cursor
         lda   #$99
output	equ	*-ofsB
         ora   #$80                     set high bit.
L5FB1    jmp   cout                     output to screen.
doread	equ	*-ofsB
         jsr   prodos8                  mli read call
         dc    i1'$CA'
         dc    i2'rd_parms'
         rts

* data area

dsp2msg	equ	*-ofsB
         dc    c'RETURN: Select | TAB: Chg Vol | '
         dc    c'ESC: Back'
         dc    i1'$00'
fldrmsg	equ	*-ofsB
         dc    h'0F'			inverse control code
         dc	h'1B'                    enable mousetext
         dc	c'XY'			folder characters
         dc	h'18'                    disable mousetext
         dc	h'0E'                    normal control code
         dc	h'00'
op_parms equ	*-ofsB			open parameters
         dc    h'03'                    3 parms
         dc	i2'pbuf'                 pathname
         dc	i2'op_buf'               file buffer
op_refn	equ	*-ofsB
	dc	h'00'			reference number
cl_parms equ	*-ofsB                   close parameters
	dc	h'01'                    1 parm
         dc	h'00'			reference number.
ol_parms equ	*-ofsB			online parameters
	dc	h'02'			2 parms
ol_unit	equ	*-ofsB
	dc	h'60'			unit number, default = s6, d1
         dc	i2'pbuf+1'               data buffer
pf_parms equ	*-ofsB			set prefix parameters
         dc    h'01'                    one parm
         dc	i2'pbuf'                 pathname
rd_parms equ	*-ofsB                   read parameters
         dc    h'04'                    4 parms
rd_refn	equ	*-ofsB
	dc	h'01'			reference number
         dc	i2'sysentry'		data buffer

* these last 2 parms (4 bytes) may extend past $300 length limit since
* the request count is set prior to using the parm block and the transfer
* count isn't used at all (except by prodos)
*	dc	h'0000'			requested length
*        dc	h'0000'                  actual length

dhdr_len equ	*-ofsB			directory header length
	dc	h'00'			(actually uses 2 bytes)

* end of obj sel_1

* object code = sel_2
*
* Alternate program selector segment for P8 when used in conjunction with
* gs/os. This code is used in place of the standard P8 interactive program
* selector when P8 is started up by GQuit. It is called when passing control
* from one application to another and the new application is 8-bit. This
* code first loads the specified P8 application at $2000 in bank 0 of memory.
* It then checks the message center for a possible name of a file. this file
* is passed on to the 8-bit application. This segment then passes control to
* the freshly loaded app. This code does NOT start with a CLD instruction
* (as other replacement quit code is supposed to do) because GQuit checks
* this to see if this version of quit code is available.

ofsQ	equ	GQdisp-dispadr		offset to GQuit dispatcher org

	msb	off
GQdisp	lda   ramin			read/write LC bank 1
         clc
         xce				16 bit native mode.
         jmp	>P8QUIT                  go to GQuit.
         dc    h'0000000000'            offset to paragraph boundary.
         dc	c'GQ'			id bytes so GQuit can identify this

* load application
*
* Entry is in 16-bit native mode. Exit is in emulation mode.
*
* On entry and exit:
*    Data bank register is set to $00.
*    Direct register is set to $0000.
*    Stack pointer is set to $01FB.
*
* Inputs: acc = value of E1_OS_Switch (0 or 1, 1 = yes to switch)
*
* This code is moved to $00/1010 and executed there.

* first, copy the prefix passed from gs/os to our own volume name buffer
* so in case of an error setting the P8 prefix, it can be displayed in the
* error message.

	SHORT	M			8 bit accumulator
         LONGI	ON
         pha                            save the switch status.
         ldx	#inbuf			point to passed prefix.
         jsr   copyvol                  copy the name into the buffer.
         pla                            retrieve the switch status

* go into emulation mode to load and run Prodos 8 application

         sec
         xce				8 bit emulation mode
         ora   #$00			switching from P16 to P8 ?
         beq   L602D                    no.

* switching from P16 to P8 so pass prefix 0 from P16 to the P8 prefix. the
* prefix is passed at $00/0200 by GQuit.

L6020    jsr   prodos8                  set prefix
         dc    i1'$C6'
         dc    i2'pfxparms'
         bcc   L602D			if prefix ok.
         jsr   gqerror                  error handler.
         bra   L6020                    try again

* load application at $2000

L602D    xce				native mode (carry clear)
	LONG	I                        16 bit regs, 8 bit acc.
         lda   pbuf+1                   is the application name
         cmp   #$2F                     a complete pathname ?
         bne   L603D                    no, use prefix as volume name
         ldx   #pbuf                    else use the application name.
         jsr   copyvol                  copy the volume name to buffer.
L603D    sec                            back to emulation mode.
         xce
L603F    jsr   prodos8                  open the application file
         dc    i1'$C8'
         dc    i2'opnparms'
         bcc   L604C                    if open ok.
         jsr   gqerror                  handle error.
         bra   L603F                    try again.
L604C    lda   oprefnum			copy ref number to parameter lists
         sta   eofrefn
         sta   rdrefnum
         sta   closeref

* do a geteof call for how many bytes to read

L6058    jsr   prodos8                  get eof
         dc    i1'$D1'
         dc    i2'eofparms'
         bcc   L6065			eof ok.
	jsr   gqerror                  handle error.
         bra   L6058                    try again.

* store the size of the file in the read parameter list

L6065    lda   eofval
         sta   rdcount
         lda   eofval+1
         sta   rdcount+1
L6071    jsr   prodos8                  read
         dc    i1'$CA'
         dc    i2'readparm'
         bcc   L607E			read ok
         jsr   gqerror
         bra   L6071
L607E    jsr   prodos8                  close
         dc    i1'$CC'
         dc    i2'closeprm'
         bcc   L608B			close ok
         jsr   gqerror
         bra   L607E
L608B    jsr   dolaunch			check for possible 2nd pathname.
         bne   L6099                    if none then run program
         jsr   ckfordrv                 else make sure the file is online.
         bcc   L6099                    if so then run the program.
         lda   #$45                     volume not found error.
         bra   L60AB
L6099    lda   romin			enable ROM
         jmp   sysentry			execute the system application
gqerror	equ	*-ofsQ
         clc
         xce				16 bit native mode
         LONG  I,M
         jsr   mountvol			mount volume.
         bcs   L60AB                    if error.
         sec                            back to emulation mode.
         xce
         rts

* generate a fatal error while running under Prodos 8.
* on input, acc = error code. this routine does not return.

L60AB    clc				native mode
         xce
         LONG  I,M
         and   #$00FF                   mask off high byte of error code.
         pha                            put on stack for IntMath tool call.
         pea   $0000			errval>>16
         pea   errval			push address of string buffer.
         pea   $0004			make string 4 digits long.
         _Int2Hex                       convert value to hex string.
         pha                            make space for return value.
         pea   $0000                    quitstr1>>16
         pea   quitstr1                 push first error message address
         pea   $0000			quitstr2>>16
         pea   quitstr2                 push second error message address
         pea   $0000			button1>>16
         pea   button1                  push first button text address
         pea   $0000                    quitbtn2>>16
         pea   quitbtn2                  push 2nd button text address (null)
         _TLTextMountVolume             make the dialog box
         pla                            retrieve button press (not used)
         sec				emulation mode
         xce
         jsr   prodos8                  quit back to GQuit
         dc    i1'$65'
         dc    i2'quitparms'

* p8 mount volume
*
* on entry: volbuf = name of volume to mount.
* on exit: carry clear if mount volume displayed and 'return' was pressed.
*          carry set if no window displayed or if had window and 'esc' pressed.

mountvol equ	*-ofsQ
         ldy   #$0000                   volbuf>>16
         ldx   #volbuf			set up pointer to volume name.

* if error is 'volume not found' or 'no disk in drive' then display the
* Mount Volume window, otherwise return with carry set.

         and   #$00FF                   mask just in case.
         cmp   #$0045                   volume not found ?
         beq   L6101                    yes
         cmp   #$002F                   no disk in drive ?
         beq   L6101                    yes
         sec                            indicate error not handled.
         rts                            return with error code still in acc.
L6101    pha				save error code in case esc pressed.
         phy                            pointer to volume name.
         phx
         tsc
         phd                            save D reg.
         tcd                            point D reg at stack.
         lda   [$01]                    get length byte and leading separator.
         dec   a                        don't count leading separator.
         xba                            then swap the bytes so the volume name
         sta   [$01]                    doesn't cpntain the separator.
         pha                            room for result.
         pea   $0000                    mountmsg>>16
         pea   mountmsg
         phy				hi word of pointer to volume name.
         inx                            skip separator.
         phx                            lo word of pointer to volume name.
         pea   $0000                    button1>>16
         pea   button1                  'Return'
         pea   $0000			button2>>16
         pea   button2                  'Escape'
         _TLTextMountVolume
         lda   [$01]                    restore first 2 bytes of vilume name
         xba                            back to their original positions
         inc   a                        and values.
         sta   [$01]
         pla                            which button: 1=Return 2=Escape.
         pld                            restore D reg.
         plx                            pull volume name pointer off stack
         plx
         cmp   #$0001                   which button was pressed ?
         bne   L613C                    if Escape pressed.
         clc                            indicate Return was pressed.
         pla                            pull original error code off stack.
         rts                            return with carry clear.
L613C    sec                            indicate Escape was pressed.
         pla                            restore error code.
         rts                            return with carry set.

* copy the volume name from the given pathname to the volume name buffer.
*
* inputs: x = length byte of complete pathname containing volume name.
* output: volume name is stored in volbuf.

copyvol	equ	*-ofsQ
         lda	|1,x			get the first slash
         sta   volbuf+1
         ldy   #$0002                   initialize the length count.
	LONGI	OFF
	LONGA	OFF
L6148    lda	|2,x			now copy the volume name up to
         cmp   #$2F                     the separating slash.
         beq	L6156
         sta	volbuf,y
         inx
         iny
         bra   L6148
L6156	dey				fix character count.
         tya                            length.
         sta   volbuf                   store the resultant string length.
         rts

* translate a filename message from the message center to the currently
* launching P8 application if it can accept a second filename. If found,
* copy the filename into the application's filename buffer.
* on exit, the z-flag is set if a filename was correctly passed to the
* application elst the z-flag is clear if it couldn't be done.

dolaunch equ	*-ofsQ
         lda   sysentry			does the app start with a jump ?
         cmp   #$4C
         bne	L616F                    no, doesn't follow the convention.
	lda	#$EE			check for the signature bytes.
         cmp   sysentry+3
         bne   L616F                    1st one doesn't match, skip it.
         cmp   sysentry+4
         beq   L6170                    both match, go get a filename message.
L616F    rts                            just return to launch the app.
L6170    lda   #$FF                     put flag conditioning value on
	pha                            the stack (assume error).
         clc                            native 16-bit mode.
         xce
         LONG  I,M
         pha                            make room on stack for user id.
         _MMStartUp                     start up the memory manager.
         pla                            get the user id and
         pha                            leave it on the stack.
         pha
         pha                            make room on stack for new handle.
         pea   $0000
         pea   $000A                    get a 10 byte block of memory.
         pha				put user id on stack.
         pea   $0000                    totally unrestricted block.
         pha                            LocationPtr (not used)
         pha
         _NewHandle                     go get the block of memory.
         pla                            get the handle from the stack.
         plx
         bcs   L620A                    branch if error, no memory available.
         phx                            leave the handle on the stack.
         pha
         pea   $0002                    'get' a message.
         pea   $0001                    get a type 1 (filename) message.
         phx                            put the message handle on the stack
         pha                            (still in acc and x regs)
         _MessageCenter
         bcs   L6203                    branch if no message.
         pha                            leave 4 bytes free on stack
         pha                            (will be used as a direct page pointer)
         tsc                            get the stack pointer.
         phd                            save current direct register.
         inc   a                        point to new direct page space.
         tcd                            make a new direct page.
         lda   [$04]                    de-reference the handle.
         sta   $00
         ldy   #$0002
         lda   [$04],y
         sta   $02
         ldy   #$0006                   get the message command.
         lda   [$00],y
         bne   bad_msg                  if print, then skip it.
         lda   $00                      adjust pointer to filename string.
         clc
         adc   #$0008
         sta   $00
         bcc   L61D1
         inc   $02
L61D1    lda   [$00]                    get the length of the string.
         and   #$00FF                   mask off high (leaving just the length)
         SHORT M                        8 bit accumulator
         cmp   sysentry+5               check against length of app buffer.
         beq   L61DF			if equal then continue with move.
         bcs   bad_msg                  if too long then bad message.
L61DF    tay                            string length.
L61E0    lda   [$00],y                  get a character.
         sta   sysentry+6,y             store it in the app's filename buffer
         sta   inbuf,y                  and in prefix buffer.
         dey
         bpl   L61E0
         lda   #$00                     change flag conditioning value on stack
         sta   $0D,s                    to indicate a filename is passed.
bad_msg	LONG  M	16-bit acc.
         pld                            restore direct register.
         pla                            fix stack because handle and userid
         pla                            still on stack.
         pea   $0003                    now delete the message (done with it).
         pea   $0001                    message type 1.
         pha                            garbage handle (not used).
         pha
         _MessageCenter                 go delete the message.
L6203    _DisposeHandle                 throw away message (handle is on stack)
L620A    _MMShutDown			shutdown the memory manager (userid is
         sec                            on stack).
         xce                            back to emulation mode.
	LONGA OFF
	pla                            condition z-flag with value on stack.
         bne   L6231                    then done.
         ldx   inbuf                    get length of pathname.
         lda   #$2F                     look for slash.
L621B    cmp	inbuf,x
         beq   L6225                    when found, set prefix.
         dex
         bne   L621B
         bra   L6231                    if no slash, just skip it.
L6225    dex                            don't include trailing slash.
         stx   inbuf                    set new length.
         jsr   prodos8                  set the P8 prefix.
         dc    i1'$C6'
         dc    i2'pfxparms'
         lda   #$00                     set z-flag
L6231	rts                            and go launch the app.

* check for disk volume
*
* on exit:
*    carry clear = disk was found
*    carry set = disk not found

ckfordrv equ	*-ofsQ
         clc				native mode
         xce
         LONG  I                        16-bit regs, 8-bit acc.
         ldx   #sysentry+6		point to pathname buffer.
         jsr   copyvol                  copy volume name to pathname buffer.
L623C    sec                            emulation mode.
         xce
         jsr   prodos8                  get info on the volume.
         dc    i1'$C4'
         dc    i2'gfiparms'
         bcc   L6252                    branch if volume found,
         clc				(native mode)
         xce
         LONG  I,M
         jsr   mountvol                 else ask user to mount the volume.
         bcc   L623C                    if <return> pressed, then try again.
         sec                            emulation mode.
         xce
         sec                            disk not found.
L6252    rts

* Prodos 8 parameter lists

pfxparms equ	*-ofsQ			set prefix parms.
         dc    h'01'                    one parm.
         dc	i2'inbuf'                address of prefix.
opnparms equ	*-ofsQ                   open parms.
	dc	h'03'                    3 parms.
         dc	i2'pbuf'                 pathname
         dc	i2'op_buf'               i/o buffer
oprefnum equ	*-ofsQ
         dc	h'00'                    reference #
eofparms equ	*-ofsQ
         dc    h'02'                    2 parms
eofrefn	equ	*-ofsQ
	dc	h'00'                    reference #
eofval	equ	*-ofsQ
	dc	h'000000'                3 byte eof value
readparm equ	*-ofsQ
         dc    h'04'                    4 parms
rdrefnum equ	*-ofsQ
	dc	h'00'                    reference #
         dc	i2'sysentry'             read into $2000 (bank 0).
rdcount	equ	*-ofsQ
         dc	h'0000'                  # of bytes to read.
         dc	h'0000'                  transfer count
closeprm equ	*-ofsQ
	dc	h'01'                    1 parm
closeref equ	*-ofsQ
         dc	h'00'                    reference #
quitparms equ	*-ofsQ
         dc    h'04'			4 parms.
         dc	h'00'                    quit back to launcher (GQuit)
         dc	h'0000'
         dc	h'00'
         dc	h'0000'
gfiparms equ	*-ofsQ			get file info parms.
         dc    h'0A'                    10 parms
         dc	i2'volbuf'               volume buffer
         dc	h'00'                    access
         dc	h'00'                    file type
         dc	h'0000'                  aux type
         dc	h'00'                    storage type
         dc	h'0000'                  blocks used
         dc    h'0000'                  modification date
         dc	h'0000'                  modification time
         dc	h'0000'                  creation date
         dc    h'0000'                  creation time

* messages for P8 fatal error. maximum length of message is 35 characters.
* the error code will be displayed immediately after the final character.

quitstr1 equ	*-ofsQ
	dc    h'1B'
         dc    c'Can''t run next application.'
quitstr2 equ	*-ofsQ
	dc    h'14'
         dc    c'ProDOS Error = $'
errval	equ	*-ofsQ			hex error code gets stored here
	dc	c'    '
quitbtn2 equ	*-ofsQ                   null string (no 2nd button)
	dc    h'00'

* messages for P8 mount volume. maximum length of message is 35 characters.
* the button labels must not be more than 16 characters.

mountmsg equ	*-ofsQ
	dc	h'17'
         dc    c'Please insert the disk:'
button1	equ	*-ofsQ
	dc    h'0D'
         dc    c'Accept: '
         dc    h'1B'			mousetext on
         dc	h'0F'                    inverse on
         dc	h'4D'                    mousetext return
         dc	h'0E'                    normal on
         dc	h'18'                    mousetext off
button2	equ	*-ofsQ
	dc	h'0B'
         dc    c'Cancel: Esc'

* end of obj sel_2 (must be < GQdisp+$300)

         end
