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 .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 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 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 lda kversion sta xdosver save current version for dir use 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 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 stz 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 ldy PAKME.SEL1+1 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 bmi * *-------------------------------------- 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 *-------------------------------------- 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 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 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 .1 jsr cmpid 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 sec 2 devices jsr installdev bra .8 .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 .2 no smartport jsr smartprt bra .8 .2 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 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) sta driveradr+1 jsr installdev install 1 or 2 devices from this slot. .7 lda idxl+1 mark a bit in slot byte and #$07 to indicate rom present. tax lda sltbit,x tsb rommap mark bit to flag rom present .8 dec idxl+1 next lower slot. lda idxl+1 and #$07 have all slots been checked ? bne .1 * 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 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 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 *-------------------------------------- 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 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 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 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 rts *-------------------------------------- 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 *-------------------------------------- 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 *-------------------------------------- * 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. * 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 *-------------------------------------- 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 spcparms .DA #$03 # of parms statunit .DA #$00 unit number (code for smartport stat) .DA numdev2 .DA #00 status code (0 = general status) 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 *-------------------------------------- LDR.Print.CX .BS 1 numdev2 .BS 8 8 bytes for smartport call driveradr .DA 0 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