NEW
  AUTO 3,1
* 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

LDR.MSG.AppleII	.AS	"Apple II"
LDR.MSG.ProDOS	.AS	"ProDOS 8 V2.0.3      "
				.AS "06-May-93"
H202F			.AS	"            "
H203B			.AS	"Copyright Apple Computer, Inc., 1983-93"
H2062			.AS	"All Rights Reserved."

p16start 		inc setuprts			set = 2 for GQuit rts
atalkset 		inc setuprts			set = 1 for appletalk rts
prostart 		lda unitnum
				sta LDR.MLIONLINE.P+1
				jsr LDR.Splash

* 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   LDR.MLIONLINE.P+1                    place boot devnum in globals
				sta   LDR.MLIREADBLOCK.P+1
				sta   devnum                   last device used
				jsr   devsrch			finish setting up globals
				lda   LDR.MLIREADBLOCK.P+1
				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 		.DA #$00				0 = normal boot, <>0 = return

* set prefix to boot device

H2267   		jsr MLI                  online
				.DA #MLIONLINE
				.DA LDR.MLIONLINE.P
				bcs relocerr
		 
				lda PrefixBuf+1			get volume name length.
				and #$0F                     strip devnum
				beq relocerr
				
				inc                        add 1 for leading '/'
				sta PrefixBuf                     save prefix length.
				lda #'/'                     place leading '/' in prefix buffer
				sta   PrefixBuf+1
		 
				jsr   MLI                  set prefix
				.DA #MLISETPREFIX
				.DA LDR.MLISETPREFIX.P
				bcs   relocerr
				
				tax						=0
				stx ZP.DstPtr
				ldy #$02                read directory into buffer
				lda /DirBlkBuf
				
H228E    		sta ZP.DstPtr+1
				sta LDR.MLIREADBLOCK.P+4
				sty LDR.MLIREADBLOCK.P+5
				stx LDR.MLIREADBLOCK.P+6
				
				jsr MLI                  read block
				.DA MLIREADBLOCK
				.DA LDR.MLIREADBLOCK.P
				bcs relocerr
				
				ldy   #$03			get next block# from link
				lda   (ZP.DstPtr),y
				tax
				dey
				ora   (ZP.DstPtr),y			if both bytes are the same
				beq   H22B7                    then no more blocks of directory.
				lda   (ZP.DstPtr),y
				tay
				lda   ZP.DstPtr+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

.1	    		lda   LDR.MSG.LdrErr,y
				sta   vline12+4,y
				dey
				bpl   .1

				bmi   *

LDR.MSG.LdrErr	.AS "Relocation/Configuration Error"

				ldy #$23
				
.1			    lda LDR.MSG.EnhErr,y
				sta vline14+2,y
				dey
				bpl .1
				
				bmi *

LDR.MSG.EnhErr	.AS "REQUIRES ENHANCED APPLE IIE OR LATER"

LDR.MLIONLINE.P	.DA #2
				.DA #$60
				.DA PrefixBuf+1
				
LDR.MLISETPREFIX.P
				.DA #1
				.DA PrefixBuf
				
LDR.MLIREADBLOCK.P
				.DA #3
				.DA #0                  unit number
				.DA 0					2 byte data buffer
				.DA 0	                2 byte block number

cortland 		.BS 1					cortland loader flag (1 = Cortland)
newquitflag 	.BS 1					1 = old quit code

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

* tables for moving 64k version of mli for execution

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

* move thunderclock

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

* move cortland clock

cortclock dc   i1'$01'                  relocation table. 1=move src to ZP.DstPtr
                .DA tclk_in'		destination
                .DA cclk_end-cclock_0'	length of cortland clock driver
                .DA cclock_0'		source
                .DA #FF'			done

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

* loader origin $800

ofsL	.EQ	licode-lodintrp		offset from loader org

licode   		jsr   MLI                  check for file 'atinit'
				.DA #MLIGETFILEINFO
				.DA #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   MLI                  open 'atinit' file
                .DA #$C8'
                .DA atopen'               parms
         bne   H23E2                    error
         lda   #$9F			max size = 39.75k ($2000-$BF00)
         sta   rdlen+1
         stz   rdlen
         jsr   MLI                  read 'atinit' file to 'sysentry'
                .DA #$CA'
                .DA rdparm'
         bne   H23E2                    error - too big
         jsr   MLI                  close 'atinit' file
                .DA #$CC'
                .DA 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
				beq *

H23F0			.DA #$1A				length of message
				.AS "Unable to load ATInit file"
				
gfi_list .EQ	*-ofsL
                .DA #0A'
	dc	i2'atinitname'
	dc	h'00'
gfi_type .EQ	*-ofsL
	dc	h'00000000'
                .DA #0000000000000000'
                .DA #0000'
atopen	.EQ	*-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 .EQ	*-ofsL
                .DA #06'			length of name
	dc	c'atinit'                name of appletalk config file
goloadint .EQ	*-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   PrefixBuf                     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   PrefixBuf,y
         ora   #$80			msb on so can be displayed if error
         sta   iomess+$11,y
         cpy   PrefixBuf
         bne   H247A
         lda   #$A0			space after name
         sta   iomess+$12,y
         tya	                         error message length
         adc   #$13                     (carry set)
         sta   ierlen
         jsr   MLI                  open interpreter file
                .DA #$C8'
                .DA opparm'
         bne   badlod
         jsr   MLI                  get eof (length of file)
                .DA #$D1'
                .DA 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   MLI                  read interpreter file
                .DA #$CA'
                .DA 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   MLI                  close interpreter file
                .DA #$CC'
                .DA 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	.EQ	*-ofsL
                .DA #00'			set if a //c.
nointrp	.EQ	*-ofsL			no interpreter found,
         jsr   MLI                  so quit.
                .DA #$65'
                .DA 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	.EQ	*-ofsL
         dc    c'**  System program too large  **'
iomess	.EQ	*-ofsL
         dc    c'** Unable to load'
	dc	c' X.System *********'
ierlen	.EQ	*-ofsL
                .DA #00'
opparm	.EQ	*-ofsL			parms for open call
	dc	h'03'
	dc	i2'PrefixBuf'
	dc	i2'iobuf'
	dc	h'01'
efparm	.EQ	*-ofsL			parms for get eof call
	dc	h'02'
                .DA #01'
eof	.EQ	*-ofsL
	dc	h'000000'		length of file.
rdparm	.EQ	*-ofsL			parms for read call
	dc	h'04'
	dc	h'01'
	dc	i2'sysentry'
rdlen	.EQ	*-ofsL
                .DA #0000'
	dc	h'0000'
clparm	.EQ	*-ofsL			parms for close call
	dc	h'01'
         dc	h'00'
quitparm	.EQ	*-ofsL		parms for quit call
	dc	h'04'
         dc	h'00'
                .DA #0000'
         dc	h'00'
         dc	h'0000'
iterp	.EQ	*-ofsL			interpreter suffix that is required
         dc    c'.SYSTEM'

* 16 bytes moved to $03F0 vectors

H257B	dc    i2'breakv'
                .DA oldrst'
                .DA #5A'			powerup byte
         jmp   oldrst                   '&' vector
         jmp   oldrst                   ctrl-y vector
                .DA #004000'
                .DA 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   (ZP.DstPtr),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

LDR.Splash		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
				
.1		   		lda H2009,x             print title
				sta vline10+16,x
				dex
				bpl .1
		 
				ldx #$1D
				
.2	    		lda H2011,x
				sta vline12+5,x
				dex
				bpl .2
				
				ldx #$0B
				
.3	    		lda H202F,x
				sta vline14+14,x
				dex
				bpl .3
				
				ldx #$26
				
.4	    		lda H203B,x
				sta vline23,x
				dex
				bpl .4
				
				ldx #$13
				
.5	    		lda H2062,x
				sta vline24+10,x
				dex
				bpl .5
				
				sec
				jsr idroutine         	returns system info
				bcs .8					taken if not a //gs
				
				lda #$80
				trb newvideo            video mode select
				
.8	    		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			.HS 0000000000000000	8 bytes for smartport call
driveradr		.DA	0
d2idx    		.DA #0
diskins2 		.DA #0					msb clear if drive in slot 2

devsrch 		stz ZP.DstPtr
				stz ZP.DstPtr+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           .DA rwts               	disk ii driver

* id bytes: evens for clock, odds for disk

dskid           .HS 082028005803703C

* slot bits
               	
sltbit			.HS 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
                .DA #00'
                .DA spcparms'             ignore any errors.
H28B1    stz   statunit                 set unit# = 0
         jsr   spvect                   call to get the device count.
                .DA #00'                    this is a status call
                .DA 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        .DA #$03			# of parms
statunit        .DA #$00            unit number (code for smartport stat)
                .DA numdev2
                .DA #00             status code (0 = general status)

* indexes into driver table

driveridx       .DA #$06				s3, d1
				.DA #$1E 				s7, d2
				.DA #$0E'           	s7, d1
				.DA #$1C'           	s6, d2
				.DA #$0C'          		s6, d1
				.DA #$1A'         		s5, d2
				.DA #$0A'               s5, d1
				.DA #$14'               s2, d2
				.DA #$04'               s2, d1
				.DA #$12'               s1, d2
				.DA #$02'               s1, d1
				.DA #$18'               s4, d2
				.DA #$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
                .DA #00'
                .DA 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
                .DA #00'
                .DA 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 ZP.DstPtr
*              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   ZP.DstPtr
         iny
         lda   (idxl),y
         sta   ZP.DstPtr+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   (ZP.DstPtr),y
         iny
         bne   H2A89
         inc   ZP.DstPtr+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   (ZP.DstPtr),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   ZP.DstPtr+1
         bcc   movup
         bne   movdn
         lda   src
         cmp   ZP.DstPtr
         bcc   movup
         bne   movdn
         rts				no move.
movup    ldy   cnt+1			calc highest page to move up
         tya                            and adj src and ZP.DstPtr.
         clc
         adc   src+1
         sta   src+1
         tya
         clc
         adc   ZP.DstPtr+1
         sta   ZP.DstPtr+1
         ldy   cnt                      move partial page 1st.
         beq   H2ADE                    taken if no partial pages
H2AD6    dey
         lda   (src),y
         sta   (ZP.DstPtr),y
         tya				end of page transfer?
         bne   H2AD6                    no
H2ADE    dec   ZP.DstPtr+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   (ZP.DstPtr),y
         iny
         bne   H2AED
         inc   ZP.DstPtr+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   (ZP.DstPtr),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         .DA #0928193C0A280D3C'
                .DA #0B2A193F0A280D3C'
                .DA #0928193F0A280D3C'
                .DA #0928193F0A280D3C'
                .DA #082A113F0A2A1D0C'
                .DA #2A2A193F0A2A1D3F'
                .DA #0A2A193F0A280D3C'
                .DA #0A2A193F0A280D3C'

wsize           .DA #$00'
sgcnt           .DA #$00'
limlo           .DA #0000000000000000'
limhi           .DA #0000000000000000'
ofset           .DA #0000000000000000'

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

patch101 		.OP 65C816
				php
				sei				disable interrupts
				clc
				xce                            full native mode

				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			.OP	65816
				lda $01,s
				sta $07,s
				lda $02,s
				sta $08,s
				pla
				pla
				pla
				lda #$00FF			#NoOS
				sec
				rtl

				.BS $2C80-*
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.203/PRODOS.S.LDR
LOAD USR/SRC/PRODOS.203/PRODOS.S
ASM