A2osX/ProDOS.FX/ProDOS.S.LDR.txt

NEW
  AUTO 3,1
*--------------------------------------
  				.MA	DEBUG
:1				bit $C000
				bpl :1
				sta	$C010
				.EM
*--------------------------------------
H2000			jmp prostart
				jmp atalkset
				jmp p16start
*--------------------------------------
LDR.MSG.0		.AT	"PRODOS FX:"
LDR.MSG.UNSUPP	.AT "UNSUPPORTED HARDWARE"
LDR.MSG.IIe		.AT "//e"
LDR.MSG.IIc		.AT "//c"
LDR.MSG.IIgs	.AT "IIgs"
LDR.MSG.Unknown	.AT "Unknown"
LDR.MSG.CLK		.AT "Clk"
LDR.MSG.RAM		.AT "/RAM"
LDR.MSG.ROOTERR	.AT "ERR reading CATALOG"
*--------------------------------------
p16start 		inc LDR.BootFlag		set = 2 for GQuit rts
atalkset 		inc LDR.BootFlag		set = 1 for appletalk rts
prostart 		lda unitnum
				sta LDR.MLIOL.P+1

				.DO READCAT=1
				sta LDR.MLIRB.P+1
				.FIN

				cld
				bit RROMBNK2

				sta CLR80DISP
				sta	CLR80STORE
				jsr setnorm
				jsr init
				jsr setvid
				jsr setkbd
				jsr home

				lda #$20
				ldx #39
				
.1				sta $400,x
				dex
				bpl .1
				
		 		ldx #LDR.MSG.0
				jsr LDR.PrintX
				
				sec
				jsr idroutine   		returns system info
				bcs .2					taken if not a //gs

				lda #$80
				trb newvideo			video mode select

* test for at least a 65c02

.2				sed
				lda #$99
				clc
				adc #$01
				cld
				bmi LDR.UNSUPP.HW

				stz auxsp
				
				sta SETALTZP

				stz auxsp
				lda auxsp
				bne LDR.UNSUPP.HW

				dec auxsp				init aux sp to $FF
				lda auxsp
				beq LDR.UNSUPP.HW

				sta CLRALTZP

				lda auxsp
				bne LDR.UNSUPP.HW		NO 128k

LDR.CheckROM	ldx #LDR.MSG.IIE
				lda #MACHID.T.IIe+MACHID.M.128+MACHID.COL80
				
				ldy $FBB3	  			check hardware id
				cpy #$06	   			apple //e?
				beq .1					if yes

				cpy #$EA	   			apple //+ or ///?
				beq LDR.UNSUPP.HW

				ldx #LDR.MSG.UNKNOWN
				bra m128k				machine is unknown, Assume //e Enh 128k

.1  			ldy $FBC0				//c ?
				bne .2
				
				ldy kbd					//c, check for keypress
				cpy #$9B	   			escape? (to disable accelerator)
				bne .11
				sta KBDSTROBE	  		clear keyboard
				
.11				lda #MACHID.T.IIc+MACHID.M.128+MACHID.COL80
				ldx #LDR.MSG.IIC
				bra m128k
				
.2				cpy #$EA
				beq LDR.UNSUPP.HW		//e UNenh....
				
				cpy #$E0
				beq .3
				
				ldx #LDR.MSG.UNKNOWN
				bra m128k				not a //e Enh....

.3				sec
				jsr $FE1F				//gs ????
				bcs m128k				no.....
				
				inc LDR.cortland
				ldx #LDR.MSG.IIGS
				lda #MACHID.T.IIe+MACHID.M.128+MACHID.COL80+MACHID.CLK
				bra m128k

LDR.UNSUPP.HW  	ldx #LDR.MSG.UNSUPP
				jsr LDR.PrintX
				bra *
*--------------------------------------
m128k  			sta idapple				Save MACHID in temp location

				sta SETALTCHAR

				jsr LDR.PrintX

				sta CLRC3ROM

				ldx #$F
				
.2				lda LDR.3F0,x
				sta $3F0,x
				dex
				bpl .2
				
				lda #$01				patch for the gs rom
				trb statereg			to force off intcxrom

				ldx #PAKME.ILDR-PAKME.Table
				ldy #ILDR.START
				lda /ILDR.START
				jsr X.Unpak.XatYA
	
				ldx #PAKME.GP-PAKME.Table
				ldy #MLI
				lda /MLI
				jsr X.Unpak.XatYA

				jsr lc1in				switch in language card bank 1.

				ldx #PAKME.XRW-PAKME.Table
				ldy #$D000
				lda /$D000
				jsr X.Unpak.XatYA

				ldx #0
				
.1				
*				stz $D700,x
				stz fcbbuf,x
				stz vcbbuf,x
*				stz $DA00,x
*				stz $DB00,x
*				stz $DC00,x
*				stz $DD00,x
				inx
				bne .1
				
				ldx #PAKME.XDOS-PAKME.Table
				ldy #$DE00
				lda /$DE00
				jsr X.Unpak.XatYA

				ldx #XDOS.DATA.LEN0		
				
.3				stz XDOS.DATA-1,x
				dex
				bne .3

				ldx #PAKME.IRQ-PAKME.Table
				ldy #$FF9B
				lda /$FF9B
				jsr X.Unpak.XatYA

LDR.IRQ			lda RROMWRAMBNK2
				ldy irqv	   			interrupt vector
				ldx irqv+1	   			x = high byte

				jsr lc1in				set language card bank 1 to r/w

				sta SETALTZP
				stx irqv+1	   			interrupt vector
				sty irqv	   			save irq vector in aux lc

				sta CLRALTZP
				stx irqv+1	   			save irq vector in main lc
				sty irqv
 			 		
				lda #calldisp
				sta jspare+1			P8 system death vector
				lda /calldisp
				sta jspare+2
				.DO LOWERCASE=0
				lda kversion
				sta xdosver				save current version for dir use
				.FIN
				lda idapple
				sta MACHID

				lda LDR.cortland
				beq LDR.II				branch if // family
*--------------------------------------
LDR.IIGS		sta cortflag

				lda #calldisp
				sta cortdisp
				lda /calldisp
				sta cortdisp+1
				
*				lda RROMWRAMBNK2

*				stz vmode				force setvid to reset cursor
*				jsr setvid	   			reset output to screen

*				jsr lc1in				set language card bank 1 to r/w

				lda #'C'
				ldx PAKME.CCLK
				ldy PAKME.CCLK+1
				jsr LDR.SetupCLK

*				ldx #PAKME.SEL2-PAKME.Table
*				ldy #$1000
*				lda /$1000
*				jsr X.Unpak.XatYA

				ldx #PAKME.SEL2-PAKME.Table
				jsr LDR.SetupQC
*--------------------------------------
				lda LDR.BootFlag
				bne .1					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

.1				bra LDR.Common
*--------------------------------------
LDR.II			ldx #PAKME.SEL1-PAKME.Table
				jsr LDR.SetupQC

				jsr	LDR.ClkDevScan
*--------------------------------------
LDR.Common		jsr LDR.BlkDevScan

				jsr LDR.SetupRAM
*--------------------------------------
				lda LDR.BootFlag		get setup entry point flag
				beq LDR.ReadRoot		taken if normal boot.
				lda RROMBNK2
				rts		  				return to caller at setup entry point.
*--------------------------------------
LDR.ReadRoot	lda LDR.MLIOL.P+1		place boot devnum in globals
				sta devnum	   			last device used

				jsr MLI
				.DA #MLIONLINE
				.DA LDR.MLIOL.P
				bcs .9
		 
				lda pbuf+1				get volume name length.
				and #$0F	   			strip devnum
				beq .9

				inc						add 1 for leading '/'
				sta pbuf	   			save prefix length.
				lda #'/'	   			place leading '/' in prefix buffer
				sta pbuf+1
		 
				jsr MLI
				.DA #MLISETPREFIX
				.DA LDR.MLISETP.P
				bcs .9

				.DO READCAT=1
				stz dst
				lda /dbuf
				ldy #$02	  			read directory into buffer
				ldx #0
				
.1  			sta dst+1
				sta LDR.MLIRB.P+3		Data buf HI
				sty LDR.MLIRB.P+4		Blk Num LO
				stx LDR.MLIRB.P+5		Blk Num HI
				jsr MLI
				.DA #MLIREADBLOCK
				.DA LDR.MLIRB.P
				bcs .9

				ldy #$03				get next block# from link
				lda (dst),y
				tax
				dey
				ora (dst),y				00 00 -> Last Block
				beq .8

				lda (dst),y
				tay
				lda dst+1
				inc
				inc						add $200 to buffer pointer
				cmp /dbuf+$800	  		until it points past end of buffer.
				bcc .1					if ok, read next block.
				.FIN
				
.8  			jmp $800				jmp to "load interpreter" code

.9		 		ldx #LDR.MSG.ROOTERR
				jsr LDR.PrintX
				bra *
*--------------------------------------
LDR.SetupQC		bit RRAMWRAMBNK2		read/write RAM bank 2
				bit RRAMWRAMBNK2

				ldy #$D100
				lda /$D100
				jsr X.Unpak.XatYA

				lda #$EE				byte to distinguish LC bank 2
				sta $D000
				jmp lc1in				switch in LC bank 1
*--------------------------------------
DS1216E.DATA1	.EQ $10
DS1216E.DATA2	.EQ A1L
*--------------------------------------
LDR.ClkDevScan	php
				sei
				lda $CFFF
				pha
				sta $C300

				ldx #7

.1				ldy #8

.2				lda $C304
				lsr
				ror DS1216E.DATA1,x
				dey
				bne .2

				dex
				bpl .1

				lda $C304				Reset DS1216E comparison register with READ A2=1
				ldx #7					Read 8 bytes...

.3				lda DS1216E.PATTERN,x
				phx
				ldx #8					....of 8 bits

.4				ldy #0
				lsr
				bcc .5

				iny

.5				pha
				lda $C300,y				Write Pattern bit in A0, with A2=0
				pla
				dex
				bne .4

				plx
				dex
				bpl .3

				ldx #7

.6				ldy #8

.7				lda $C304
				lsr
				ror DS1216E.DATA2,x
				dey
				bne .7

				dex
				bpl .6

				pla
				bmi .8

				sta $CFFF

.8				plp

				ldx #7

.9				lda DS1216E.DATA1,x
				cmp DS1216E.DATA2,x
				bne LDR.ClkDevTCLK

				dex
				bpl .9

				lda #'N'
				ldx PAKME.NCLK
				ldy PAKME.NCLK+1
				bra LDR.SetupCLK
*--------------------------------------
LDR.ClkDevTCLK	lda CLRC8ROM	   		switch out $C8 ROMs
				
				stz idxl
				lda #$C1
				sta idxl+1
				
.1				ldy #6
				
.2  			lda (idxl),y	   		compare id bytes
				cmp dskid,y
				bne .3
				dey
				dey
				bpl .2	

				lda #'T'
				ldx PAKME.TCLK
				ldy PAKME.TCLK+1
				jsr LDR.SetupCLK
				
				lda idxl+1
				sta TCLK.Cx1+2
				sta TCLK.Cx2+2			
				rts

.3				inc idxl+1
				lda idxl+1
				cmp #$C8
				bne .1
				rts
*--------------------------------------
LDR.SetupCLK	stx ZPInBufPtr
				sty ZPInBufPtr+1
				
				jsr LDR.PrintA
				ldx #LDR.MSG.CLK
				jsr LDR.PrintX
		
				lda #$D742
				sta ZPOutBufPtr
				lda /$D742
				sta ZPOutBufPtr+1
				jsr X.Unpak

				lda #$4C	   			enable clock routine by putting a jmp
				sta clockv	   			in front of clock vector

				lda #MACHID.CLK
				tsb MACHID
LDR.SetupCLK.RTS
				rts
*--------------------------------------
LDR.SetupRAM	lda DEVCNT
				cmp #13
				bcs LDR.SetupCLK.RTS

				jsr lc1in

				ldx #PAKME.RAM-PAKME.Table
				ldy #$FF00
				lda /$FF00
				jsr X.Unpak.XatYA

				sta SETWRITEAUX

				ldx #PAKME.RAMX-PAKME.Table
				ldy #$0200
				lda /$0200
				jsr X.Unpak.XatYA

				sta CLRWRITEAUX

				lda #RAMDRV				put driver address into
				sta	DEVPTRS3D2
				lda /RAMDRV
				sta	DEVPTRS3D2+1

				inc DEVCNT				count (-1) active devices
				ldx DEVCNT
				lda #$BF				unit num of /RAM
				sta	DEVLST,x
				
				ldx #LDR.MSG.RAM
				jmp LDR.PrintX
*--------------------------------------
* find all disk devices in system slots and set up address
* and device table in prodos global page. 
*--------------------------------------
LDR.BlkDevScan	stz idxl
				lda #$C7	  			search slots from high to low
				sta idxl+1

				lda #7
				sta LDR.SlotIdx
				
.1	  			lda LDR.SlotIdx
				jsr LDR.CheckDiskID
				bcs .8					if no ProDOS device in this slot.

				ldy #$ff
				lda (idxl),y	  		check last byte of $Cn rom (y = $ff)
				bne .2		   			branch if 16 sector disk II.

				sta	devid				=0 since disk ii's have null attributes
				lda #RWTS
				sta driveradr
				lda /RWTS
				sta driveradr+1
				sec						2 devices
				jsr LDR.AddBlkDevs
				bra .7

.2				cmp #$FF	   			if = $FF then 13 sector disk II.
				beq .8					ignore if 13 sector boot ROM

				ldy #$07	   			check for a smartport device.
				lda (idxl),y
				bne .3					no smartport

				jsr LDR.AddSPDevs
				bra .7

.3  			ldy #$FE				BLK device...
				lda (idxl),y			get attributes.
				and #$03	   			verify it provides read and status calls.
				cmp #$03
				bne .7					assume it's an off-brand disk
				
				lda (idxl),y			get back ID byte
				lsr
				lsr
				lsr
				lsr
				sta devid				->DEV LIST NIBBLE

				and #$3					Device count minus 1
				inc
				ldx LDR.SlotIdx
				sta LDR.SlotDevCnt-1,x
				tax
				
				iny						$CnFF
				lda (idxl),y
				sta driveradr
				lda idxl+1	   			store hi entry addr (low already done)
				sta driveradr+1

				cpx #2					CS if 2 devs or more
				jsr	LDR.AddBlkDevs		install 1 or 2 devices from this slot.

.7  			ldx LDR.SlotIdx
				lda sltbit,x
				tsb rommap	   			mark bit to flag rom present
				
.8				dec idxl+1				next lower slot.
				dec LDR.SlotIdx 		have all slots been checked ?
				bne .1
*--------------------------------------
LDR.AddExtraDevs
				stz idxl
				lda #$C7
				sta idxl+1
				
				lda #7
				sta LDR.SlotIdx

.1  			ldx LDR.SlotIdx
				lda LDR.SlotDevCnt-1,x
				cmp #3
				bcc .8

				ldy LDR.SlotDevType-1,x
				bne .2
				
				jsr LDR.AddExtraBlkDevs
				bra .8

.2				jsr LDR.AddExtraSPDevs

.8  			dec LDR.SlotIdx
				bne .1
LDR.AddExtraDevs.RTS
				rts
*--------------------------------------
LDR.AddSPDevs 	jsr LDR.SetDevID		setup the devid byte from attributes

				iny						#$ff
				lda (idxl),y
				
				sta driveradr
				sta .1+1				modify operand
				clc
				adc #$03
				sta spvect+1

				lda idxl+1
				sta driveradr+1
				sta spvect+2
				sta .1+2				modify operand

				asl						convert $Cn to $n0
				asl
				asl
				asl
				sta unitnum	  			unit number

				stz A4L					force a prodos status call

				stz buf					dummy pointer
				lda #$10
				sta buf+1				dummy pointer should be <> 0

				stz bloknml	  			# of bytes to transfer
				stz bloknml+1

.1				jsr	$0000				SELF MODIFIED
				
				ldy #$FB	
				lda (idxl),y			check device id
				and #$02	   			SCSI?
				beq .2					no, no need to init Cocoon

				sta LDR.SPStatus.U 		device = 2 for SCSI

				jsr spvect				status of Cocoon
				.HS 00
				.DA LDR.SPStatus.P 		ignore any errors.

.2  			stz LDR.SPStatus.U 		set unit# = 0
				jsr spvect	   			call to get the device count.
				.HS 00					this is a status call
				.DA LDR.SPStatus.P
				lda LDR.SPStatus.Buf
				beq LDR.AddExtraDevs.RTS	no devices, so done.

				sta LDR.DevCnt
				
				ldx LDR.SlotIdx
				inc LDR.SlotDevType-1,x	set as smartport
				
.3				inc LDR.SPStatus.U

				jsr spvect	   			call to get the device status
				.HS 00					this is a status call
				.DA LDR.SPStatus.P
				bcs .7

				lda LDR.SPStatus.Buf
				bpl .7					not a block device
				
				ldx LDR.SlotIdx
				inc LDR.SlotDevCnt-1,x

.7				dec LDR.DevCnt
				bne .3
				
				ldx LDR.SlotIdx
				lda LDR.SlotDevCnt-1,x
				beq LDR.AddBlkDevs.RTS

				cmp #2					CC/CS, add 1 or 2 devs
*--------------------------------------
LDR.AddBlkDevs	php						how many drives (carry).
				lda idxl+1	   			get index to global device table
				and #$07	  			for this slot...
				asl
				tay		  				into y reg.

				asl
				asl						now form device # = slot #
				asl						in high nibble.

				ora devid				combine with attributes.
				ldx DEVCNT	  
				inx		  				put device # into device list.
				sta DEVLST,x
				asl						now form drive 2 device number, if any.

				plp						restore # of devices in carry.
				ror						if 2 drives, then bit 7=1.
				bpl .1					branch if a 1 drive device (e.g. hard drive)

				inx		  				else presume that 2nd drive is present.
				sta DEVLST,x	  		active device list.

.1  			stx DEVCNT	  		save updated device count.
				asl						shift # of drives back into carry.
				lda driveradr			get high address of device driver.
				sta DEVPTRS,y	 		device driver table 1.
				bcc .2					branch if single drive.
				sta DEVPTRS+16,y	 	device driver table 2.

.2  			lda driveradr+1
				sta DEVPTRS+1,y
				bcc .3
				sta DEVPTRS+17,y

.3
LDR.AddBlkDevs.RTS  			
				rts
*--------------------------------------
LDR.AddExtraBlkDevs
				rts
*--------------------------------------
LDR.AddExtraSPDevs
				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

				jsr LDR.SetDevID		set up device attributes
				stz LDR.SPStatus.U

				jsr spvect				do a status call on smartport itself
				.HS 00
				.DA LDR.SPStatus.P
				
				lda LDR.SPStatus.Buf	# of devices on smartport

				cmp #$03
				bcc .8					only 2 devices,skip to next one.

				dec
				dec
				sta LDR.DevCnt

				lda #3
				sta LDR.SPStatus.U

.1				jsr spvect	   			do status call
				.HS 00
				.DA LDR.SPStatus.P
				lda LDR.SPStatus.Buf	is this a block device?
				bpl .2

				jsr LDR.MountSPDevs
				bcs .8
				
.2  			inc LDR.SPStatus.U
				dec LDR.DevCnt
				bne .1
				
.8				rts
*--------------------------------------
LDR.MountSPDevs	ldx #LDR.DEVPTRS.CNT-1

.1  			ldy LDR.DEVPTRS.IDX,x
				lda DEVPTRS,y	 		device driver table 1
				cmp #nodevice
				bne .2

				lda DEVPTRS+1,y
				cmp /nodevice
				beq .3
				
.2  			dex
				bpl .1
				
				sec
				rts
				
.3				jsr lc1in				write enable LC ram bank 1.

				tya						divide index by 2
				lsr
				tax
				
				lda LDR.SPStatus.U
				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 RROMBNK2			write protect lc ram.

				inc DEVCNT
				ldx DEVCNT
				tya

				asl						convert to DSSS0000
				asl
				asl

				ora devid				include device attributes
				sta DEVLST,x	  		in the active device list.

				lda #XDOS.SPREMAP
				sta DEVPTRS,y	 		device driver table 1
				lda /XDOS.SPREMAP
				sta DEVPTRS+1,y
				clc
				rts
*--------------------------------------
* self modifying jmp = smartport entry address
*--------------------------------------
spvect 			jmp	$0000				self modifying
*--------------------------------------
LDR.CheckDiskID	lda CLRC8ROM	   		switch out $C8 ROMs

				ldy #$05

.1  			lda (idxl),y	   		compare id bytes
				cmp dskid,y
				sec		  				set if no disk card
				bne .2

				dey
				dey
				bpl .1					loop until all 4 id bytes match.

				clc						clear if disk card
.2  			rts
*--------------------------------------
LDR.SetDevID	ldy #$FE				check attributes byte.

				lda (idxl),y
				lsr						move hi nibble to lo nibble for
				lsr						device table entries.
				lsr
				lsr
				sta devid
				rts
*--------------------------------------
LDR.PrintA		ldy LDR.Print.CX
				and #$7F
				cmp #$60
				bcs .2
				and #$3F
.2				sta $400,y
				inc LDR.Print.CX
				rts
*--------------------------------------
LDR.PrintX		ldy LDR.Print.CX

.1				lda $2000,x
				pha
				and #$7F
				cmp #$60
				bcs .2
				and #$3F
.2				sta $400,y
				
				inx
				iny
				pla
				bpl .1
				
*				lda #$20
*				sta $400,y
				iny						Add a Space
				sty LDR.Print.CX
				rts
*--------------------------------------
DS1216E.SIG		.HS	5CA33AC55CA33AC5	Reverted 7->0
*--------------------------------------
* id bytes: evens for clock, odds for disk
dskid	 		.HS 082028005803703C
sltbit			.HS 0002040810204080
*--------------------------------------
LDR.MLIOL.P		.DA #2
				.DA #$60
				.DA pbuf+1

LDR.MLISETP.P	.DA #1
				.DA pbuf
				
				.DO READCAT=1
LDR.MLIRB.P		.DA #3
				.DA #0	  				unit number
				.DA 0					2 byte data buffer
				.DA 0		 			2 byte block number
				.FIN

LDR.SPStatus.P	.DA #$03				# of parms
LDR.SPStatus.U	.DA #$00				unit number (code for smartport stat)
				.DA LDR.SPStatus.Buf
				.DA #00	 				status code (0 = general status)

LDR.DEVPTRS.CNT	.EQ 14

LDR.DEVPTRS.IDX	.DA #$16				S3D2
				.DA #$06				S3D1
				.DA #$1E				S7D2
				.DA #$0E				S7D1
				.DA #$1C				S6D2
				.DA #$0C				S6D1
				.DA #$1A				S5D2
				.DA #$0A				S5D1
				.DA #$14				S2D2
				.DA #$04				S2D1
				.DA #$12				S1D2
				.DA #$02				S1D1
				.DA #$18				S4D2
				.DA #$08				S4D1
*--------------------------------------
LDR.Print.CX	.BS 1
*--------------------------------------
LDR.SPStatus.Buf .BS 8					8 bytes for smartport call
driveradr		.BS 2
LDR.SlotIdx		.BS 1
LDR.DevCnt		.BS 1
LDR.SlotDevCnt	.BS 7
LDR.SlotDevType	.BS 7
LDR.cortland 	.DA #0					cortland loader flag (1 = Cortland)
LDR.BootFlag	.DA #0					0 = normal boot, <>0 = return
*--------------------------------------
* 16 bytes moved to $03F0 vectors
*--------------------------------------
LDR.3F0			.DA breakv
				.DA oldrst
				.DA #$5A				powerup byte
				jmp oldrst	  			'&' vector
				jmp oldrst	   			ctrl-y vector
				.HS 004000
				.DA GP.IRQV				global page interrupt vector
lc1in  			lda RRAMWRAMBNK1
				lda RRAMWRAMBNK1
				rts
*--------------------------------------
* patch to gsos vectors so error is returned for os calls - rev note #101
*--------------------------------------
patch101 		php
				sei						disable interrupts
				clc
				xce		  				full native mode
				>LONGMX
				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
				>IIGS 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
				>IIGS 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 1,s
				sta 7,s
				lda 2,s
				sta 8,s
				pla
				pla
				pla
				lda ##$00FF				#NoOS
				sec
				rtl
*--------------------------------------
MAN
SAVE USR/SRC/PRODOS.FX/PRODOS.S.LDR
LOAD USR/SRC/PRODOS.FX/PRODOS.S
ASM