NEW AUTO 3,1 *-------------------------------------- .MA DEBUG :1 bit $C000 bpl :1 sta $C010 .EM *-------------------------------------- READCAT .EQ 0 Boot Block read Catalog at $C00 *-------------------------------------- H2000 jmp prostart jmp atalkset jmp p16start *-------------------------------------- LDR.MSG.0 .AS "PRODOS FX: " LDR.MSG.0.LEN .EQ *-LDR.MSG.0 LDR.MSG.UNSUPP .AS -"UNSUPPORTED HARDWARE." LDR.MSG.UNSUPP.LEN .EQ *-LDR.MSG.UNSUPP LDR.MSG.ROOTERR .AS -"Unable To read ROOT dir." LDR.MSG.ROOTERR.LEN .EQ *-LDR.MSG.ROOTERR *-------------------------------------- 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 cld bit RROMBNK2 sta CLR80DISP sta CLR80STORE jsr setnorm jsr init jsr setvid jsr setkbd jsr home ldx #LDR.MSG.0.LEN-1 .1 lda LDR.MSG.0,x and #$3F sta $400,x dex bpl .1 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 lda #MACHID.T.IIe+MACHID.M.128+MACHID.COL80 ldx $FBB3 check hardware id cpx #$06 apple //e? beq .1 if yes cpx #$EA apple //+ or ///? beq LDR.UNSUPP.HW bra m128k machine is unknown, Assume //e Enh 128k .1 ldx $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 bra m128k .2 cpx #$EA beq LDR.UNSUPP.HW //e UNenh.... cpx #$E0 bne m128k not a //e Enh.... sec jsr $FE1F //gs ???? bcs m128k no..... inc cortland lda #MACHID.T.IIe+MACHID.M.128+MACHID.COL80+MACHID.CLK bra m128k LDR.UNSUPP.HW ldy #LDR.MSG.UNSUPP.LEN-1 .1 lda LDR.MSG.UNSUPP,y sta vline14+2,y dey bpl .1 bmi * m128k sta idapple Save MACHID in temp location 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 lda PAKME.ILDR sta ZPInBufPtr lda PAKME.ILDR+1 sta ZPInBufPtr+1 lda #ILDR.START sta ZPOutBufPtr lda /ILDR.START sta ZPOutBufPtr+1 jsr X.Unpak lda PAKME.GP sta ZPInBufPtr lda PAKME.GP+1 sta ZPInBufPtr+1 lda #MLI sta ZPOutBufPtr lda /MLI sta ZPOutBufPtr+1 jsr X.Unpak jsr lc1in switch in language card bank 1. lda PAKME.XRW sta ZPInBufPtr lda PAKME.XRW+1 sta ZPInBufPtr+1 lda #$D000 sta ZPOutBufPtr lda /$D000 sta ZPOutBufPtr+1 jsr X.Unpak ldx #0 .1 stz $D700,x stz $D800,x stz $D900,x stz $DA00,x stz $DB00,x stz $DC00,x stz $DD00,x inx bne .1 lda PAKME.XDOS sta ZPInBufPtr lda PAKME.XDOS+1 sta ZPInBufPtr+1 lda #$DE00 sta ZPOutBufPtr lda /$DE00 sta ZPOutBufPtr+1 jsr X.Unpak ldx #XDOS.DATA.LEN .3 stz XDOS.DATA-1,x dex bne .3 lda PAKME.IRQ sta ZPInBufPtr lda PAKME.IRQ+1 sta ZPInBufPtr+1 lda #$FF9B sta ZPOutBufPtr lda /$FF9B sta ZPOutBufPtr+1 jsr X.Unpak lda kversion sta xdosver save current version for dir use lda idapple sta MACHID lda cortland beq LDR.II branch if // family LDR.IIGS stz vmode force setvid to reset cursor jsr setvid reset output to screen lda #calldisp sta cortdisp lda /calldisp sta cortdisp+1 lda #1 sta cortflag ldx PAKME.CCLK ldy PAKME.CCLK+1 jsr LDR.SetupCLK ldx PAKME.SEL2 ldy PAKME.SEL2+1 stx ZPInBufPtr sty ZPInBufPtr+1 lda #$1000 sta ZPOutBufPtr lda /$1000 sta ZPOutBufPtr+1 jsr X.Unpak ldx PAKME.SEL2 ldy PAKME.SEL2+1 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 jmp RAMDRV.Install * put dispatcher in bank 2 of language card LDR.II ldx PAKME.SEL1 ldy PAKME.SEL1+1 jsr LDR.SetupQC * check for a rom in slot 3. if no rom, use internal $C300 firmware .2 sta CLRC3ROM lda rommap slot ROM bit map and #$08 mask all but slot 3 bne isromin3 taken if rom in slot 3 bra CLK.Install 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 SETC3ROM lda $C305 check card id bytes cmp #$38 bne hitswtch not terminal card lda $C307 cmp #$18 bne hitswtch lda $C30B cmp #$01 bne hitswtch lda $C30C is it an apple 80 col compatible card? and #$F0 cmp #$80 bne hitswtch if not. lda $C3FA cmp #$2C does card have an interrupt handler? beq docard yes hitswtch sta CLRC3ROM * verify that the card in aux slot is actually present sta SET80STORE sta SETPAGE2 lda #$EE sta txtp2 asl asl txtp2 cmp txtp2 bne .1 lsr lsr txtp2 cmp txtp2 .1 sta CLRPAGE2 sta CLR80STORE beq docard branch if card is there lda #MACHID.COL80 lda machid machine ID byte trb MACHID clear 80-col bit 2 (no card) bra CLK.Install docard lda #MACHID.COL80 tsb MACHID turn bit 2 on (80-col card is present) CLK.Install jsr LDR.ClkDevScan *-------------------------------------- RAMDRV.Install jsr lc1in ldx PAKME.RAM ldy PAKME.RAM+1 stx ZPInBufPtr sty ZPInBufPtr+1 lda #$FF00 sta ZPOutBufPtr lda /$FF00 sta ZPOutBufPtr+1 jsr X.Unpak sta SETWRITEAUX ldx PAKME.RAMX ldy PAKME.RAMX+1 stx ZPInBufPtr sty ZPInBufPtr+1 lda #$0200 sta ZPOutBufPtr lda /$0200 sta ZPOutBufPtr+1 jsr X.Unpak sta CLRWRITEAUX lda #RAMDRV put driver address into sta drivertbl2+6 slot 3, drive 2. lda /RAMDRV sta drivertbl2+7 inc GP.numdevs count (-1) active devices ldx GP.numdevs lda #$BF unit num of /RAM sta devlist,x 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 LDR.MLIOL.P+1 place boot devnum in globals sta LDR.MLIRB.P+1 sta devnum last device used jsr LDR.BlkDevScan finish setting up globals lda LDR.MLIRB.P+1 sta devnum lda #calldisp sta jspare+1 P8 system death vector lda /calldisp sta jspare+2 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.BootFlag .DA #$00 0 = normal boot, <>0 = return * set prefix to boot device LDR.ReadRoot 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 sta RROMBNK2 jsr home ldy #LDR.MSG.ROOTERR-1 .91 lda LDR.MSG.ROOTERR,y sta vline12+4,y dey bpl .91 bmi * LDR.MLIOL.P .DA #2 .DA #$60 .DA pbuf+1 LDR.MLISETP.P .DA #1 .DA pbuf LDR.MLIRB.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) *-------------------------------------- LDR.SetupQC bit RRAMWRAMBNK2 read/write RAM bank 2 bit RRAMWRAMBNK2 stx ZPInBufPtr sty ZPInBufPtr+1 lda #$D100 sta ZPOutBufPtr lda /$D100 sta ZPOutBufPtr+1 jsr X.Unpak 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 DS1216E.SIG .HS 5CA33AC55CA33AC5 Reverted 7->0 *-------------------------------------- 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 ldx PAKME.NCLK ldy PAKME.NCLK+1 jmp 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 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 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 *-------------------------------------- * 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 *-------------------------------------- LDR.BlkDevScan stz dst stz dst+1 stz idxl ldx #$FF init to no active devices. stx GP.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 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 #RWTS sta driveradr lda /RWTS 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 GP.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 GP.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 GP.numdevs current device count - 1 lda #$0E sec sbc d2idx beq H2747 if there were no disk //'s then done. clc adc GP.numdevs sum of disk //'s and others. sta GP.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 GP.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 bne H275A pla iny H275A dex bpl H274C ldx GP.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 rts stadrv ora devid combine with attributes. ldx GP.numdevs inx put device # into device list. sta devlist,x asl now form drive 2 device number, if any. rts sltrom bcc H27F3 branch if disk drive * 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 * id bytes: evens for clock, odds for disk dskid .HS 082028005803703C * slot bits sltbit .HS 0002040810204080 installdev 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. jsr stadrv OR in low nibble, store in dev list. 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 devlist,x active device list. .1 stx GP.numdevs save updated device count. asl shift # of drives back into carry. lda driveradr get high address of device driver. sta drivertbl1,y device driver table 1. bcc .2 branch if single drive. sta drivertbl2,y device driver table 2. .2 lda driveradr+1 sta drivertbl1+1,y bcc .3 sta drivertbl2+1,y .3 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 convert $Cn to $n0 asl asl asl 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 .1 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 .HS 00 .DA spcparms ignore any errors. .1 stz statunit set unit# = 0 jsr spvect call to get the device count. .HS 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. lda (idxl),y lsr move hi nibble to lo nibble for lsr device table entries. lsr lsr sta devid rts * check unknown card to see if disk id = $Cn00:nn 20 nn 00 nn 03 cmpid 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 * 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 .DA #$1E .DA #$0E .DA #$1C .DA #$0C .DA #$1A .DA #$0A .DA #$14 .DA #$04 .DA #$12 .DA #$02 .DA #$18 .DA #$08 * 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 jsr setdevid set up device attributes stz statunit jsr spvect do a status call on smartport itself .HS 00 .DA spcparms lda numdev2 # of devices on smartport cmp #$03 bcc H2974 only 2 devices,skip to next one. inc 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 .HS 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 bra H295B H2974 dec idxl+1 lda idxl+1 cmp #$C0 searched down to slot 0? bne H291F if not. rts mount ldx #$0C .1 ldy driveridx,x lda drivertbl1,y device driver table 1 cmp #nodevice bne .2 lda drivertbl1+1,y cmp /nodevice beq .3 .2 dex bpl .1 rts ran out of space for devices, exit. * empty slot found .3 lda idxl+1 pha phx phy tya which slot is empty? lsr 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 .2 yes, can't use to mirror the device. jsr lc1in write enable LC ram bank 1. tya divide index by 2 lsr 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 RROMBNK2 write protect lc ram. inc GP.numdevs ldx GP.numdevs tya lsr cmp #$08 bcc nodev2 drive 2 mount sbc #$08 ora #$08 nodev2 asl asl asl asl 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 .9 no, so return. sec assume no smartport ldy #$07 lda (idxl),y is it a smartport? bne .9 if not. clc smartport found .9 rts numdev2 .HS 0000000000000000 8 bytes for smartport call driveradr .DA 0 d2idx .DA #0 diskins2 .DA #0 msb clear if drive in slot 2 *-------------------------------------- * 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