P* * JamaicaMON * * Original supermon source code courtesy Jim Butterfield * * Merlinized and adapted for the SuperCPU by * Stephen L. Judd * 12/7/97 (1/98) * * v1.0 1/31/98 * v1.1 2/2/98 (totally stupid bugfix) * * This program is public domain. * * Direct page variables tmpc = $22 nemo = $23 length = $24 wrap = $25 acmd = $26 aflg = $27 ;3 bytes satus = $90 lvflag = $93 indev = $99 outdev = $9a eal = $ae eah = $af fnlen = $b7 wtype = $b9 fa = $ba fnadr = $bb psav = $57 tmp2 = $5a tmp0 = $5d savx = $60 inbuf = $0100 scpu = $0208 ;scpu stuff stage = $0210 ohone = $022f pbr = $0230 pcl = $0231 pch = $0232 acc = $0233 xr = $0235 yr = $0237 sp = $0239 dp = $023b dbr = $023d flgs = $023e emul = $023f ;high bit = e addrs = $0240 ;load/save string bkvec = $0316 ldvec = $0330 svvec = $0332 ready = $a002 setmsg = $ff90 rdt = $ffcf wrt = $ffd2 stop1 = $ffe1 kload = $ffd5 ksave = $ffd8 ; ** initialization ** super clc >>> xce ;native mode >>> rep,$30 ;everyone 16-bits >>> per,vbreak sei pla sta bkvec >>> per,break pla >>> sta1,$fc9d ;NBRK >>> sta1,$7c9d lda #00 dfb 00 dfb $5b ;DP -> zero-page >>> sep,$30 ;everyone 8-bits >>> sta1,$fc9f ;bank 0 >>> sta1,$7c9f cli lda #$80 jsr setmsg brk *------------------------------- * Debugging routines do 0 debug1 lda #00 sta $d020 rts debug2 inc $d020 :wait jsr $ffe4 beq :wait rts fin * txt 'ah, moon of my delight that knows no wane' vbreak ; ** vector break entry ** >>> ply >>> plx pla ; ** break entry ** break cli clc >>> xce >>> rep,$30 >>> phd pha lda #00 dfb 00 >>> tcd ;direct reg=$0000 sty yr stx xr pla sta acc pla sta dp >>> sep,$30 ;everyone 8-bits ror emul ;high bit = e hex af010000 ;LDA $000001 sta ohone ora #$02 hex 8f010000 lda $d0b2 ;SuperCPU status reg sta scpu lda $d0bc ;RAMLink status sta $d073 ;sys speed to turbo sta scpu+1 and #%01000000 beq :skip sta $df20 ;rl wrt-prot off sta $df7f ;rl hw reg out :skip sta $d0bf ;dos ext ,pde pff sta $d07f ;scpu hw out >>> phb pla sta dbr pla sta flgs >>> rep,$30 pla sec hex e90200 ;SBC #0002 sta pcl >>> sep,$30 lda #00 ldx emul bmi :emul pla :emul sta pbr >>> tsc sta sp >>> xba sta sp+1 lda pcl cmp brkaddr bne :notbrk lda pch sbc brkaddr+1 bne :notbrk lda pbr sbc brkaddr+2 bne :notbrk jsr getp2 lda brkinst dfb $87,tmp0 ;STA [TMP0] lda #$ff sta brkaddr sta brkaddr+1 sta brkaddr+2 :notbrk jsr crlf ldx #$42 lda #$2a jsr wrtwo lda #$52 bne s0 ; ** print addresses ** whereami ldy #'n' jsr altrit jsr space >>> per,super >>> plx pla jsr wrax >>> per,endcode >>> plx pla jsr wrax >>> per,endvars >>> plx pla jsr wrax jmp strt ; ** write 16-bits in X,A ** wrax stx tmpc jsr wrob lda tmpc jsr wrob jmp space ; ** increment temp pointer ** inctmp inc tmp0 bne setwr inc tmp0+1 bne setwr inc wrap setwr rts ; ** read character ** rdoc jsr rdt cmp #$0d bne setwr pla pla ; ** prompt for command ** strt lda #0 sta wrap ldx #$0d lda #$2e jsr wrtwo ; ** check input command ** st1 jsr rdoc cmp #$2e beq st1 cmp #$20 beq st1 s0 ldx #$16 s1 cmp keyw,x bne s2 txa asl tax >>> per,super >>> rep,$20 pla clc adc kaddr,x pha >>> sep,$30 rts s2 dex bpl s1 jmp error ; ** help! i need somebody ** help jsr crlf ldx #00 :loop lda keyw,x beq strt jsr wrt inx bne :loop ; ** set pc addrress ** putp2 lda tmp0+2 sta pbr putp lda tmp0 sta pcl lda tmp0+1 sta pch rts ; ** get pc addrress ** getp2 lda pbr sta tmp0+2 getp lda pcl sta tmp0 lda pch sta tmp0+1 rts ; ** memory display ** dm jsr olddm >>> bra,memadj olddm lda #$08 sta tmpc ldy #$ff :loop jsr space iny jsr fetchy jsr wrob dec tmpc bne :loop sty length rts ; ** text display ** dt lda #$08 sta tmpc ldy #$ff :loop iny jsr fetchy jsr wrtext dec tmpc bne :loop sty length memadj jsr pcadj sta tmp0 sty tmp0+1 rts ; ** change memory ** byte jsr rdob bcc by3 bytest dfb $87,tmp0 ;STA [TMP0] dfb $c7,tmp0 ;CMP [TMP0] beq by3 jmp error by3 jsr inctmp dec tmpc rts ; ** store address ** word jsr rdob pha jsr byte pla jmp bytest ; ** set pc reg addrs ** setr lda #acc sta tmp0+1 lda #00 sta tmp0+2 lda #8 rts ; ** write display prompt ** altrit >>> phy jsr crlf pla ldx #$2e jmp wrtwo ; ** print text ** prreg lda regk,x beq :done jsr wrt inx bne prreg :done jmp altrit ; **display registers ** dsplyr jsr displayr jmp strt displayr ldx #0 ldy #$3b jsr prreg lda #00 ldy emul bmi :skip lda pbr :skip jsr wrob jsr space ldy #00 :loop lda pcl+1,y jsr wrob lda pcl,y jsr wrob jsr space iny iny cpy #10 bcc :loop lda flgs jsr wrbin lda emul asl jmp wrbit ; ** display extra regs dispr2 ldx #regk2-regk ldy #'^' jsr prreg lda dbr jsr wrob jsr space lda dp+1 jsr wrob lda dp jsr wrob jsr space lda ohone jsr wrob >>> brl,a9 ; ** display memory/mem+text ** dsplyt lda #$ff dfb $2c dsplym lda #$00 sta aflg jsr rdoc jsr read24 bcc errs1 ldx tmp0 stx tmp2 ldx tmp0+1 stx tmp2+1 ldx tmp0+2 stx tmp2+2 cmp #$0d beq dsp1 jsr read24 bcc errs1 jsr t2t2 dsp1 jsr stop1 beq altjmp ldx wrap bne altjmp jsr diffp bcc altjmp lda aflg bmi :text ldy #$3a jsr altrit jsr wroa24 jsr dm >>> bra,dsp1 :text jsr crlf jsr wroa24 jsr olddm jsr space jsr dt jsr pcadj >>> bra,dsp1 errs1 jmp error ; ** alter main regs ** altr jsr rdob bcc :skip1 sta pbr :skip1 jsr rdoc jsr rdoa bcc :skip2 jsr putp :skip2 jsr setr sta tmpc :loop jsr rdoc jsr word bne :loop jsr rdoc jsr getbits sta flgs jsr getbit ror emul bpl altjmp lda flgs ora #$30 sta flgs altjmp jmp strt ; ** alternate regs ** altr2 jsr rdob sta dbr jsr rdoc jsr rdob sta dp+1 jsr rdob sta dp jsr rdoc jsr rdob bcc :exit sta ohone :exit jmp strt ; ** alter memory ** altm jsr read24 bcc errs1 lda #$08 sta tmpc bne :loop2 ;kludge :loop jsr rdoc :loop2 jsr byte bne :loop a9 jmp strt errs2 jmp error ; ** Set breakpoint setbrk jsr rdt jsr read24 jsr setbrk2 jsr prline jmp strt setbrk2 lda tmp0 sta brkaddr lda tmp0+1 sta brkaddr+1 lda tmp0+2 sta brkaddr+2 jsr fetch ;lda [tmp0] tay lda #00 dfb $87,tmp0 ;sta [tmp0] tya sta brkinst rts ; ** Single step ** singstep lda #00 dfb $2c ; ** .go ** go lda #$ff pha jsr rdt cmp #$0d beq :g1 cmp #$20 bne errs2 jsr read24 jsr putp2 :g1 pla bmi :nobrk jsr getp2 jsr fetch jsr getmidx jsr pcadj sta tmp0 sty tmp0+1 jsr setbrk2 :nobrk sta $d07e ;restore SCPU stuff lda scpu+1 ;dos ext + rl status sta $d0bc and #$40 beq :skip sta $df7e :skip lda scpu sta $d0b2 lda dbr pha >>> plb jsr getsp >>> tcs sei lda ohone hex 8f010000 asl emul bcs :emul lda pbr pha :emul lda pch pha lda pcl pha lda flgs pha >>> rep,$30 lda dp pha lda acc ldx xr ldy yr >>> pld >>> xce rti ; ** back to basic ** exit jsr getsp >>> tcs sec >>> xce jmp (ready) ; ** read 1 or 2 chars ** read12 jsr rdoc jsr hexit sta acmd jsr rdt cmp #$2c beq :skip cmp #$0d beq :skip jsr hexit asl acmd asl acmd asl acmd asl acmd ora acmd sta acmd jsr rdt :skip ldx acmd rts ; ** load/save ** ld ldy #1 sty fa sty wtype dey sty fnlen sty satus sty lvflag lda #addrs sta fnadr+1 jsr getchar cmp #$0d beq l5 cmp #$22 bne errl l3 jsr rdt cmp #$22 beq l8 cmp #$0d beq l5 sta (fnadr),y inc fnlen iny cpy #$10 bne l3 errl jmp error l8 jsr rdt cmp #$0d beq l5 cmp #$2c bne errl jsr read12 pha txa and #$0f beq errl cmp #$03 beq errl sta fa pla cmp #$0d beq l5 cmp #$2c bne errl jsr read24 bcc errl dec wtype ldx $f7e5 ;check for 24-bit load/save cpx #$91 beq :cont dec wtype ldx tmp0+2 stx $b0 :cont cmp #$0d l5 rts load jsr ld bne errl ldx tmp0 ldy tmp0+1 lda #00 jsr kload lda satus and #$10 bne errl jmp strt save jsr ld cmp #$2c bne errl jsr t2t2 jsr read24 bcc errl cmp #$0d bne errl lda $f7e5 ;check for 24-bit load/save cmp #$91 beq :cont lda tmp0+2 sta $ab :cont ldx tmp0 ldy tmp0+1 lda #tmp2 jsr ksave jmp strt ; ** print text char ** wrtext cmp #32 bcc :zap cmp #128 bcc :ok cmp #160 bcs :ok :zap lda #'.' :ok jmp wrt ; ** print hex byte ** wroa24 lda tmp0+2 jsr wrob wroa lda tmp0+1 jsr wrob lda tmp0 wrob pha lsr a lsr a lsr a lsr a jsr ascii tax pla and #$0f jsr ascii ; ** print two chars ** wrtwo pha txa jsr wrt pla jmp wrt ; ** convert to ascii ** ascii ora #$30 cmp #$3a bcc asc1 adc #$06 asc1 rts ; ** print a binary byte ** wrbin sta tmpc ldy #08 :loop asl tmpc jsr wrbit dey bne :loop rts ; ** print bit in C ** wrbit lda #'0' adc #00 jmp wrt ; ** read binary byte ** getbits lda #8 sta savx :loop jsr getbit rol tmpc dec savx bne :loop lda tmpc rts ; ** read a bit ** getbit jsr rdoc cmp #'1' rts ; ** swap tmp0, tmp2 ** t2t2 ldx #$03 t2t21 lda tmp0-1,x pha lda tmp2-1,x sta tmp0-1,x pla sta tmp2-1,x dex bne t2t21 rts ; ** read 16/24 bit hex addr ** read24 jsr rdoa bcc rderr read24b ldx pbr stx tmp0+2 jsr rdt cmp #$0d beq rdexit cmp #$20 beq rdexit cmp #$2c beq rdexit rdoa24 jsr rdob2 bcc rdexit ldx tmp0+1 stx tmp0+2 ldx tmp0 stx tmp0+1 sta tmp0 jsr rdt ;.a = next char sec rts rderr jmp error ; ** read hex address ** rdoa jsr rdob rdoa1 bcc rdoa2 sta tmp0+1 rdoa2 jsr rdob bcc rdexit sta tmp0 rdexit rts ; ** scan for hex byte ** rdob lda #0 sta acmd jsr rdoc rdob1 cmp #$20 bne rdob2 jsr rdoc cmp #$20 bne rdob3 clc rts ; ** read hex byte ** rdob2 jsr hexit asl a asl a asl a asl a sta acmd jsr rdoc rdob3 jsr hexit ora acmd sec rts ; ** convert from hex ** hexit cmp #$3a bcc hex08 adc #$08 hex08 and #$0f rts ; ** decrement t0,t2 ** spread = tmp2-tmp0 dect2 ldx #>> tcs lda #$3f jsr wrt jmp strt ; ** get stack pointer ** getsp >>> rep,$30 lda sp >>> sep,$30 rts ; ** print spaces ** spacd jsr space dex bne spacd rts ; ** inc tmp 2 ** ptrinc inc tmp2 bne p1ov inc tmp2+1 p1ov rts ; ** swap aflg, tmp0 ** swap ldx #$03 swp1 lda tmp0-1,x pha lda aflg-1,x sta tmp0-1,x pla sta aflg-1,x dex bne swp1 rts ; ** calc tmp2-tmp0-2 ** diffb lda tmp2 ldy tmp2+1 ldx tmp2+2 sec sbc #2 bcs deck dey cpy #$ff bne deck dex >>> bra,deck ; ** calc aflg-tmp0 ** diffa lda aflg ldy aflg+1 ldx aflg+2 >>> bra,deck ; ** calc tmp2-tmp0 ** diffp lda tmp2 ldy tmp2+1 ldx tmp2+2 deck sec sbc tmp0 sta nemo >>> xba tya sbc tmp0+1 tay ora nemo sta nemo txa sbc tmp0+2 tax ora nemo rts ; ** check address range ** chkrange ldy #01 ;0 < addr-begin < end-begin ldx length sec :loop jsr fetchy sbc tmp2-1,y sta stage+5,y iny dex bne :loop bcc :rts ldx length ldy #01 sec :loop2 lda aflg-1,y sbc stage+5,y iny dex bne :loop2 :rts rts ; ** relocate ** relocate lda #$ff dfb $2c ; ** .transfer ** trans lda #00 sta tmpc jsr input pha jsr t2t2 pla jsr get2b pha lda tmpc beq :skip jsr diffp ;start-end code = -# of bytes bcs :err >>> xba sta stage sty stage+1 inx bne :err pla jsr get2b ;end vars pha :skip jsr diffp bcc :ok beq :ok :err jmp error :ok jsr swap pla jsr get2b ;dest lda tmp0+2 sta :mov+1 lda tmp2+2 sta :mov+2 >>> phb >>> rep,$30 ldx tmp2 ldy tmp0 lda aflg sec sbc tmp2 sta aflg ;end-begin :mov hex 540000 ;MVN >>> sep,$30 >>> plb lda tmpc bne reloc jmp strt ;** relocate chunk of code ** reloc dfb $64,aflg+2 ;stz jsr diffp ;begin-dest >>> xba sta stage+3 sty stage+4 stx stage+5 :loop jsr fetch jsr getmidx lda acmd ;modes 9-e, 11 are absolute cmp #9 bcc :nope cmp #$0f bcc :maybe cmp #$11 bne :nope :maybe jsr chkrange bcc :nope ldx length ldy #01 sec :yep jsr fetchy sbc stage+2,y dfb $97,tmp0 ;STA [TMP0],Y iny dex bne :yep :nope jsr pcadj sta tmp0 sty tmp0+1 lda stage sec adc length sta stage bcc :loop inc stage+1 bne :loop jmp strt ; ** .fill ** fill jsr input pha jsr t2t2 pla jsr get2b cmp #$0d beq error2 jsr t2t2 jsr rdob bcc error2 sta tmpc flup1 ldx wrap bne strt1 jsr diffp bcc strt1 lda tmpc dfb $87,tmp0 ;sta [tmp0] jsr inctmp bne flup1 error2 jmp error strt1 jmp strt ; ** .hunt ** hunt jsr input pha jsr t2t2 pla jsr get2b cmp #$0d beq error2 jsr t2t2 ldx #0 jsr rdoc cmp #$22 bne nostrh jsr rdoc hpar sta stage,x inx jsr rdt cmp #$0d beq htgo cmp #$22 beq htgo cpx #$1e bne hpar beq htgo nostrh stx inbuf jsr rdob1 bcc error2 hlp sta stage,x inx jsr rdt cmp #$0d beq htgo jsr rdob bcc error2 cpx #$1e bne hlp htgo stx savx jsr crlf hscan jsr stop1 beq hnjmp ldx #0 ldy #0 hlp3 jsr fetchy cmp stage,x bne hnmtch iny inx cpx savx bne hlp3 ; ** match found ** jsr wroa24 jsr space hnmtch jsr inctmp ldx wrap bne strt1 jsr diffp bcs hscan hnjmp jmp strt ; ** Fetch a byte using $01 ** fetchy php sec dfb $2c fetch php clc >>> phx ldx $01 lda ohone sta $01 bcs :fetchy dfb $a7,tmp0 ;lda [tmp0] dfb $2c :fetchy dfb $b7,tmp0 ;lda [tmp0],y stx $01 >>> plx plp and #$ff ;set flags rts ; ** .disassemble ** disas jsr rdoc jsr read24 lda tmp0 sta psav lda tmp0+1 sta psav+1 lda tmp0+2 sta psav+2 ldx #0 stx aflg dpag lda #$93 ;clr jsr wrt lda #$16 sta tmpc dislp jsr diss1 jsr pcadj sta tmp0 sty tmp0+1 dec tmpc bne dislp lda #$91 ;up jsr wrt jmp strt ; ** diss 1 line ** diss1 ldy #',' jsr altrit jsr space diss1a jsr wroa24 jsr space jsr fetch jsr getmidx ;mnemonic index txa pha ldy #0 jsr disvv pla tax jsr propxx jsr prlchar ;leading chars jsr praddr ;address jmp prechar ;final chars ;** Compute mnemonic index,mode ** getmidx lsr tay bcc :even :odd cmp #$44 ;BIT # bne :notbit ldx #6 lda #1 bne :len :notbit and #$07 ;Exception is $xB cmp #%00000101 beq :except tya lsr lsr lsr lsr ;msd/16/2 tax lda nemtab2,x tax tya and #$0f tay ;low 5 bits/2 lda modetab2,y bpl :len ;.X .A = mnemonic, adr mode :except tya lsr lsr lsr tay ldx nemtab+$80,y lda #00 ;All are mode 0 beq :len :even ldx nemtab,y lda modetab,y :len sta acmd ;mode tay lda modelen,y sta length dey bne chkrts ;** test for 16-bit ** jsr fetch check16 cmp #$a2 ;LDX beq :xchk and #$0f ;CPX CPY LDY beq :xchk cmp #9 ;SEP REP bne chkrts lda #%00100000 dfb $2c :xchk lda #%00010000 and flgs bne chkrts inc length chkrts rts ;** print leading chars ** prlchar lda acmd beq done cmp #1 bne :c1 ldx #'#' bne :two :c1 cmp #14 bcc :dollar ldx #'(' cmp #20 bcc :two ldx #'[' :two txa jsr wrt :dollar lda #'$' jmp wrt ;** print address ** praddr ldy length beq done lda acmd cmp #2 beq prmove cmp #3 beq prel cmp #4 beq prel :loop jsr fetchy jsr wrob dey bne :loop done rts ;** MVN/MVP address ** prmove jsr :print ldx #',' lda #'$' jsr wrtwo dey :print jsr fetchy jmp wrob ; ** print rel address ** prel ldx #00 jsr fetchy clc bpl :test dex :test dey ;length beq :8bit tax jsr fetchy sec :8bit adc #2 ;bleah bcc :calc inx clc :calc jsr pcadj2 tax tya jsr prbyte txa prbyte stx savx jsr wrob ldx savx rts ;** print end characters ** prechar ldy acmd :square cpy #20 bcc :commas lda #']' jsr wrt :commas ldx #',' cpy #19 beq :prs cpy #5 bne :commax :prs lda #'s' jsr wrtwo :commax jsr iscomx bne :paren lda #'x' jsr wrtwo :paren cpy #14 bcc :commay cpy #20 bcs :commay lda #')' jsr wrt :commay jsr iscomy bne :bye lda #'y' jsr wrtwo :bye rts ;** Check for ,x and ,y ** iscomx cpy #7 beq :rts cpy #10 beq :rts cpy #13 beq :rts cpy #17 beq :rts cpy #18 :rts rts iscomy cpy #8 beq :rts cpy #11 beq :rts cpy #16 beq :rts cpy #19 beq :rts cpy #21 :rts rts ; ** add length+1 to pc ** pcadj ldx #00 lda length sec pcadj2 adc tmp0 ;result-> .A .Y = lo hi pha txa adc tmp0+1 tay pla rts ; print bytes disvv jsr fetchy ;lda [tmp0],y jsr prbyte ldx #1 disvl jsr spacd cpy length iny bcc disvv ldx #$03 cpy #4 bcc disvl rts ; ** print mnemonic in .X ** propxx lda mneml,x sta aflg lda mnemr,x sta aflg+1 ldx #3 :loop1 lda #0 ldy #$05 :loop2 asl aflg+1 rol aflg rol a dey bne :loop2 adc #$40 jsr wrt dex bne :loop1 ; ** print space ** space lda #$20 bne flip ; ** print cr, maybe lf ** crlf lda #$0d bit $13 bpl flip jsr wrt lda #$0a flip jmp wrt ; **.p disassemble ** prin jsr input pha jsr t2t2 pla jsr get2b jsr t2t2 dfb $64,aflg ;STZ ploop jsr crlf jsr diss1a jsr pcadj sta tmp0 sty tmp0+1 jsr stop1 beq strtx jsr diffp bcs ploop strtx jmp strt ; ** re-disassemble ** redis jsr input lda #$04 sta tmpc :loop jsr byte beq :done jsr rdoc cmp #$20 beq :loop :done lda psav sta tmp0 lda psav+1 sta tmp0+1 lda psav+2 sta tmp0+2 jmp dpag findmnem ldx #91 ;Find mnemonic in the table :loop lda mneml,x cmp stage bne :next lda mnemr,x cmp stage+1 bne :next stx stage ;Mnemonic index rts :next dex bpl :loop jmp error islead ;** Is .A a leading char? :loop cmp leadchar,x beq :out dex bpl :loop :out rts isend ldx #3 ;** Is .A an ending char? :loop cmp endchar,x beq :out dex bpl :loop :out rts ;** Flip X and M bits ** flipbit jsr rdt ldx #$30 cmp #'m' bne :c1 ldx #$20 :c1 cmp #'x' bne :c2 ldx #$10 :c2 lda emul bmi :skip txa eor flgs sta flgs :skip jsr displayr pla pla jmp asmnext ;** Read in and pack mnemonic packm hex 9c ;STZ da stage hex 9c da stage+1 jsr gtchr cmp #'!' beq flipbit pha jsr rdoc pha jsr rdoc pha ldy #3 :loop2 pla ldx #5 :loop lsr ror stage ror stage+1 dex bne :loop dey bne :loop2 jmp findmnem ;...and find it in the table ;** Assemble ** assemble jsr rdoc jsr read24 ;address bcc jerr1 cmp #$0d bne ardarg jmp strt ardarg jsr packm ;mnemonic jsr getchar ;argument ldx #7 jsr islead bne jerr1 dfb $64,aflg ;STZ AFLG txa asl tax >>> per,super >>> rep,$20 pla clc adc leadadr,x pha >>> sep,$30 rts ;** Form number from stack cpstack pla sta tmp2 pla sta tmp2+1 ldy #00 :loop txa ;.X contains # of bytes beq :skip dex pla :skip sta stage+4,y iny cpy #3 ;zero out any extra bne :loop txa bne jerr1 ;No more than 24 bits beq restore ;** Read in an address getaddr jsr getchar ;(of arbitrary length) getaddr3 cmp #'$' bne jerr1 getaddr2 pla sta tmp2 pla sta tmp2+1 dfb $64,tmpc ;Count # of bytes read dfb $64,acmd jsr rdt :loop jsr rdob1 ;read hex bytes bcc jerr1 pha inc tmpc dfb $64,acmd jsr rdt jsr isend bne :loop ldx tmpc restore tay lda tmp2+1 pha lda tmp2 pha tya rts jerr1 jmp error *** Instruction modes ;** Absolute mode $ abs jsr getaddr2 stx stage+2 ldy times3p3,x sty stage+1 bne absend abs8 ldy #1 ;Zero page absolute < hex 2c ;BIT abs16 ldy #2 ;16-bit absolute ! hex 2c abs24 ldy #3 ;24-bit absolute > sty stage+2 ;max # of bytes allowed lda times3p3,y sta stage+1 ;addressing mode jsr getaddr cpx stage+2 bcc absend bne jerr1 absend stx tmpc cmp #$0d ;last char read beq :done cmp #',' ;index bne jerr1 jsr rdt ldx tmpc cmp #'$' beq :move cmp #'s' beq :stack inc stage+1 cmp #'x' beq :done inc stage+1 cmp #'y' bne jerr1 :done ldy stage+1 cpy #14 ;13 is highest bcs jerr1 jmp instout :stack cpx #1 ;d,s bne jerr1 ldy #5 jmp instout :move dex ;** MVN/MVP d,d bne jerr1 jsr getaddr2 dex ;1 byte only bne jerr1 ldx #2 ldy #2 jmp instout indir jsr getaddr ;** Indirect () stx stage+2 cmp #')' bne :index ldy #14 sty stage+1 dex bne :done inc stage+1 jsr rdt cmp #$0d beq :done inc stage+1 jsr rdoc cmp #'y' bne jerr2 :done ldy stage+1 ldx stage+2 jmp instout :index cmp #',' bne jerr2 ldy #17 dex bne :zp iny :zp sty stage+1 jsr rdoc cmp #'x' beq :done cmp #'s' bne jerr2 lda #19 sta stage+1 jsr rdt jsr rdt jsr rdt cmp #'y' beq :done jerr2 jmp error lindir jsr getaddr ;Long indirect [] stx stage+2 dex bne jerr2 cmp #']' bne jerr2 ldy #20 sty stage+1 jsr rdt cmp #$0d beq :done inc stage+1 jsr rdt cmp #'y' bne jerr2 :done ldx stage+2 ldy stage+1 >>> bra,instout accum ldy #0 ;No arguments ldx #0 beq instout ;** Immediate addressing # immed jsr getaddr cmp #$0d ;End with a CR! bne jerr2 ldy #1 ;.Y = address mode ;** Check and output inst bytes instout sty stage+1 jsr cpstack jsr isop2 ;Search through opcode tables bcc :gotcha jsr isop1 bcc :gotcha jmp error :gotcha sta stage+3 ;opcode ldx stage+1 ;mode ldy modelen,x ;number of bytes dex bne :loop sty length jsr check16 ldy length :loop lda stage+3,y dfb $97,tmp0 ;sta [tmp0],y dey bpl :loop jsr prline ;print assembled line jsr pcadj ;inc tmp0 sta tmp0 sty tmp0+1 asmnext ldy #'a' jsr altrit jsr space jsr wroa24 jsr space jmp ardarg ;** print assembled line prline jsr crlf lda #145 ;up jsr wrt jsr wrt jmp diss1 ;** Search through nemtab2 isop2 ldy #$07 lda stage :loop cmp nemtab2,y beq :mode dey bpl :loop cmp #6 ;BIT bne :fail ldx stage+1 dex bne :fail ldy #8 lda #$89 clc rts :mode ldx #15 ;16 possible modes lda stage+1 :loop2 cmp modetab2,x beq :crazy dex bpl :loop2 :fail sec rts :crazy txa ;Figure out this crazy thing sec rol ;low 5 bits of opcode sta tmpc tya asl ;msb = mnem*32 asl asl asl asl ora tmpc ;add to get opcode cmp #$89 ;STA # beq :fail clc rts ;** Search through table 1 ** isop1 ldy #$7f lda stage :loop cmp nemtab,y bne :dey ldx modetab,y cpx stage+1 beq :gotcha cpx #3 ;Check for relative addresses beq :rel cpx #4 beq :rel :dey dey bpl :loop ldy #$8f ;second part of table ldx stage+1 ;$xB is all no args bne :exit :loop2 cmp nemtab,y beq :gotcha2 :dey2 dey bmi :loop2 :exit sec rts :rel lda stage+1 cmp #9 ;a bne :exit stx stage+1 lda stage+2 cmp #2 bne :exit jsr makerel ;make address relative :gotcha tya asl rts :gotcha2 tya asl asl asl asl ora #$0b rts ;** Convert stage address to rel makerel stx tmpc dec tmpc lda stage+4 sec sbc tmpc ;2/3 for r/rlong bcs :cont dec stage+5 sec :cont sbc tmp0 sta stage+4 lda stage+5 sbc tmp0+1 sta stage+5 cpx #3 ;check for overflow bne :rts lda stage+4 clc adc #$80 lda stage+5 adc #00 beq :rts jmp error :rts rts endcode txt 'brevity is... wit.' * Variables brkinst dfb 0 ;Old break instruction brkaddr dfb 0,0,0 ;address keyw txt ':;rmgxls' txt 'tfhdp,ae^bziwn?',00 kaddr dw altm-super-1 dw altr-super-1 dw dsplyr-super-1 dw dsplym-super-1 dw go-super-1 dw exit-super-1 dw load-super-1 dw save-super-1 dw trans-super-1 dw fill-super-1 dw hunt-super-1 dw disas-super-1 dw prin-super-1 dw redis-super-1 dw assemble-super-1 dw dispr2-super-1 dw altr2-super-1 dw setbrk-super-1 dw singstep-super-1 dw dsplyt-super-1 dw whereami-super-1 dw relocate-super-1 dw help-super-1 regk dfb $0d txt ' pbr pc ' txt ' ac xr yr sp ' txt ' vnmxdizce' dfb 00 regk2 dfb 13 txt ' dbr dp 01',00 endchar txt ',)]' dfb $0d ;return! leadchar txt '$!><([#' dfb 13 leadadr da abs-super-1 ;Absolute da abs8-super-1 ;Absolute ZP da abs16-super-1 ;Absolute 16-bit da abs24-super-1 ;Absolute long da indir-super-1 ;Indirect da lindir-super-1 ;Long indirect da immed-super-1 ;Immediate da accum-super-1 ;Accumulator times3p3 dfb 3,6,9,12,15 ;x*3+3 ;opcode mnemonic table index nemtab dfb 11,20,80,2,49,2,80,2 ;$0x dfb 9,41,79,2,15,27,79,2 ;$1x dfb 33,32,6,59,55,59,6,59 ;$2x dfb 7,1,6,59,65,23,6,59 ;$3x dfb 61,89,39,37,45,37,31,37 ;$4x dfb 13,26,38,37,17,51,31,37 ;$5x dfb 63,44,73,60,52,60,31,60 ;$6x dfb 14,0,73,60,67,57,31,60 ;$7x dfb 10,12,72,71,25,83,72,71 ;$8x dfb 3,69,72,71,86,84,73,73 ;$9x dfb 36,35,36,35,75,74,36,35 ;$ax dfb 4,34,36,35,18,82,36,35 ;$bx dfb 22,58,22,23,29,24,22,23 ;$cx dfb 8,19,43,23,16,50,30,23 ;$dx dfb 21,68,21,27,28,40,21,27 ;$ex dfb 5,64,42,27,66,56,33,27 ;$fx dfb 47,77,54,81,48,76,62,78 ;last row = $xb / 16 dfb 46,85,53,87,88,70,90,91 ;even opcodes: ORA AND EOR ADC ; STA LDA CMP SBC nemtab2 dfb 41,1,26,0,69,34,19,64 ; opcode mode table for above ; 0= A/i/s 6= d b= a,y 10= (d),y ; 1= # 7= d,x c= al 11= (a,x) ; 2= d,d 8= d,y d= al,x 12= (d,x) ; 3= rel 9= a e= (a) 13= (d,s),y ; 4= rlong a= a,x f= (d) 14= [d] ; 5= d,s 15= [d],y modetab dfb 0,0,6,6,0,0,9,9 hex 030f06070000090a ;$1x hex 090c060600000909 ;$2x hex 030f070700000a0a ;$3x hex 0006020600000909 ;$4x hex 030f020700000c0a ;$5x hex 0004060600000e09 ;$6x hex 030f07070000110a ;$7x hex 0304060600000909 ;$8x hex 030f07080000090a ;$9x hex 0101060600000909 ;$ax hex 030f070800000a0b ;$bx hex 0101060600000909 ;$cx hex 030f0f0700000e0a ;$dx hex 0101060600000909 ;$ex hex 030f09070900110a ;$fx modetab2 hex 1205061401ff090c ;odd opcodes hex 101307150bff0a0d ;most sig. 5 bits ; Address mode lengths modelen dfb 0,1,2,1,2,1 dfb 1,1,1,2,2 dfb 2,3,3,2,1 dfb 1,2,1,1,1,1 ; packed mnemonics mneml mnemr = mneml+92 endvars = mnemr+92