150 lines
8.4 KiB
Fennel
150 lines
8.4 KiB
Fennel
(local {: int8-to-bytes : int16-to-bytes : int24-to-bytes} (require "lib.util"))
|
|
|
|
(local opcodes {})
|
|
|
|
; http://www.oxyron.de/html/opcodes816.html
|
|
; The 65816 has an opcode for every possible byte. Rather than implementing any kind of tricky encoder logic, we just build a lookup table directly.
|
|
(let [ops [[:brk nil] [:ora :idx] [:cop :imm] [:ora :sr] [:tsb :dp] [:ora :dp] [:asl :dp] [:ora :idl] ; 0x00-0x07
|
|
[:php nil] [:ora :imm] [:asl nil] [:phd nil] [:tsb :abs] [:ora :abs] [:asl :abs] [:ora :abl] ; 0x08-0x0f
|
|
[:bpl :rel] [:ora :idy] [:ora :idp] [:ora :isy] [:trb :dp] [:ora :dpx] [:asl :dpx] [:ora :idly] ; 0x10-0x17
|
|
[:clc nil] [:ora :aby] [:inc nil] [:tcs nil] [:trb :abs] [:ora :abx] [:asl :abx] [:ora :alx] ; 0x18-0x1f
|
|
[:jsr :abs] [:and :idx] [:jsr :abl] [:and :sr] [:bit :dp] [:and :dp] [:rol :dp] [:and :idl] ; 0x20-0x27
|
|
[:plp nil] [:and :imm] [:rol nil] [:pld nil] [:bit :abs] [:and :abs] [:rol :abs] [:and :abl] ; 0x28-0x2f
|
|
[:bmi :rel] [:and :idy] [:and :idp] [:and :isy] [:bit :dpx] [:and :dpx] [:rol :dpx] [:and :idly] ; 0x30-0x37
|
|
[:sec nil] [:and :aby] [:dec nil] [:tsc nil] [:bit :abx] [:and :abx] [:rol :abx] [:and :alx] ; 0x38-0x3f
|
|
[:rti nil] [:eor :idx] [:wdm nil] [:eor :sr] [:mvp :bm] [:eor :dp] [:lsr :dp] [:eor :idl] ; 0x40-0x47
|
|
[:pha nil] [:eor :imm] [:lsr nil] [:phk nil] [:jmp :abs] [:eor :abs] [:lsr :abs] [:eor :abl] ; 0x48-0x4f
|
|
[:bvc :rel] [:eor :idy] [:eor :idp] [:eor :isy] [:mvn :bm] [:eor :dpx] [:lsr :dpx] [:eor :idly] ; 0x50-0x57
|
|
[:cli nil] [:eor :aby] [:phy nil] [:tcd nil] [:jmp :abl] [:eor :abx] [:lsr :abx] [:eor :alx] ; 0x58-0x5f
|
|
[:rts nil] [:adc :idx] [:per :rell] [:adc :sr] [:stz :dp] [:adc :dp] [:ror :zp] [:adc :idl] ; 0x60-0x67
|
|
[:pla nil] [:adc :imm] [:ror nil] [:rtl nil] [:jmp :ind] [:adc :abs] [:ror :abs] [:adc :abl] ; 0x68-0x6f
|
|
[:bvs :rel] [:adc :idy] [:adc :idp] [:adc :isy] [:stz :dpx] [:adc :dpx] [:ror :zpx] [:adc :idly] ; 0x70-0x77
|
|
[:sei nil] [:adc :aby] [:ply nil] [:tdc nil] [:jmp :iax] [:adc :abx] [:ror :abx] [:adc :alx] ; 0x78-0x7f
|
|
[:bra :rel] [:sta :idx] [:brl :rell] [:sta :sr] [:sty :dp] [:sta :dp] [:stx :dp] [:sta :idl] ; 0x80-0x87
|
|
[:dey nil] [:bit :imm] [:txa nil] [:phb nil] [:sty :abs] [:sta :abs] [:stx :abs] [:sta :abl] ; 0x88-0x8f
|
|
[:bcc :rel] [:sta :idy] [:sta :idp] [:sta :isy] [:sty :dpx] [:sta :dpx] [:stx :dpy] [:sta :idly] ; 0x90-0x97
|
|
[:tya nil] [:sta :aby] [:txs nil] [:txy nil] [:stz :abs] [:sta :abx] [:stz :abx] [:sta :alx] ; 0x98-0x9f
|
|
[:ldy :imm] [:lda :idx] [:ldx :imm] [:lda :sr] [:ldy :dp] [:lda :dp] [:ldx :dp] [:lda :idl] ; 0xa0-0xa7
|
|
[:tay nil] [:lda :imm] [:tax nil] [:plb nil] [:ldy :abs] [:lda :abs] [:ldx :abs] [:lda :abl] ; 0xa8-0xaf
|
|
[:bcs :rel] [:lda :idy] [:lda :idp] [:lda :isy] [:ldy :dpx] [:lda :dpx] [:ldx :dpy] [:lda :idly] ; 0xb0-0xb7
|
|
[:clv nil] [:lda :aby] [:tsx nil] [:tyx nil] [:ldy :abx] [:lda :abx] [:ldx :aby] [:lda :alx] ; 0xb8-0xbf
|
|
[:cpy :imm] [:cmp :idx] [:rep :imm] [:cmp :sr] [:cpy :dp] [:cmp :dp] [:dec :dp] [:cmp :idl] ; 0xc0-0xc7
|
|
[:iny nil] [:cmp :imm] [:dex nil] [:wai nil] [:cpy :abs] [:cmp :abs] [:dec :abs] [:cmp :abl] ; 0xc8-0xcf
|
|
[:bne :rel] [:cmp :idy] [:cmp :idp] [:cmp :isy] [:pei :idp] [:cmp :dpx] [:dec :dpx] [:cmp :idly] ; 0xd0-0xd7
|
|
[:cld nil] [:cmp :aby] [:phx nil] [:stp nil] [:jmp :ial] [:cmp :abx] [:dec :abx] [:cmp :alx] ; 0xd8-0xdf
|
|
[:cpx :imm] [:sbc :idx] [:sep :imm] [:sbc :sr] [:cpx :dp] [:sbc :dp] [:inc :dp] [:sbc :idl] ; 0xe0-0xe7
|
|
[:inx nil] [:sbc :imm] [:nop nil] [:xba nil] [:cpx :abs] [:sbc :abs] [:inc :abs] [:sbc :abl] ; 0xe8-0xef
|
|
[:beq :rel] [:sbc :idy] [:sbc :idp] [:sbc :isy] [:pea :imm] [:sbc :dpx] [:inc :dpx] [:sbc :idly] ; 0xf0-0xf7
|
|
[:sed nil] [:sbc :aby] [:plx nil] [:xce nil] [:jsr :iax] [:sbc :abx] [:inc :abx] [:sbc :alx] ; 0xf8-0xff
|
|
]
|
|
mnemonic-to-modemap {}]
|
|
(each [iop [mnemonic mode] (ipairs ops)]
|
|
(when (= (. mnemonic-to-modemap mnemonic) nil)
|
|
(tset mnemonic-to-modemap mnemonic {}))
|
|
(tset mnemonic-to-modemap mnemonic (or mode :nil) (- iop 1)))
|
|
(each [mnemonic modemap (pairs mnemonic-to-modemap)]
|
|
(tset opcodes mnemonic (fn [mode] (. modemap (or mode :nil))))))
|
|
(set opcodes.jsl #(when (= $1 :abl) 0x22)) ; allow forced long subroutine calls
|
|
|
|
(fn dp-addr [addr]
|
|
(when (and (= (type addr) :string) (= (addr:sub 1 1) :d))
|
|
(tonumber (addr:sub 2))))
|
|
(fn addr-parser [addr] (or (dp-addr addr) (tonumber addr)))
|
|
|
|
(fn explicit-mode-arg [arg]
|
|
(var result nil)
|
|
(when (= (type arg) :table)
|
|
(each [mode arg (pairs arg)]
|
|
(when (= (type mode) :string)
|
|
(set result [mode arg]))))
|
|
result)
|
|
|
|
(fn parse-mode-arg [op]
|
|
(match op
|
|
(where [_ arg] (explicit-mode-arg arg)) (explicit-mode-arg arg)
|
|
(where [mvx srcbank dstbank]
|
|
(= (type srcbank) :number) (= (type dstbank) :number) (= (mvx:sub 1 2) :mv))
|
|
[:bm [dstbank srcbank]] ; encoded backwards for some reason
|
|
[_ offset :s] [:sr offset]
|
|
[_ :#8 imm] [:imm8 imm]
|
|
(where [_ imm] (or (= (type imm) :number) (= (type imm) :function))) [:imm imm]
|
|
[_ [[addr]] :y] [:idly addr]
|
|
[_ [addr :s] :y] [:isy addr]
|
|
[_ [addr] :y] [:idy addr]
|
|
; can tell ial / idl apart by the mnemonic
|
|
[:jmp [[addr]]] [:ial addr]
|
|
[_ [[addr]]] [:idl addr]
|
|
; can tell iax / idx apart by the mnemonic
|
|
[:jmp [addr :x]] [:iax addr]
|
|
[:jsr [addr :x]] [:iax addr]
|
|
[_ [addr :x]] [:idx addr]
|
|
; rell is the only valid mode for two mnemonics
|
|
[:per addr] [:rell addr]
|
|
[:brl addr] [:rell addr]
|
|
; rel is the only valid mode for other branches
|
|
(where [br addr] (= (type addr) "string") (= (br:sub 1 1) "b") (not= br :bit)) [:rel addr]
|
|
(where [_ addr :x] (dp-addr addr)) [:dpx addr]
|
|
(where [_ addr :y] (dp-addr addr)) [:dpy addr]
|
|
(where [_ [addr]] (dp-addr addr)) [:idp addr]
|
|
(where [_ addr] (dp-addr addr)) [:dp addr]
|
|
[_ [addr]] [:ind addr]
|
|
[_ addr :y] [:aby addr]
|
|
[:jsl addr] [:abl addr] ; jsl is always long
|
|
; we'll assume local bank for now and fix up bankswitching in :patch
|
|
[_ addr :x] [:abx addr]
|
|
[_ addr] [:abs addr]
|
|
[_] [nil nil]
|
|
_ (error (.. "Unrecognized syntax" (fv op)))))
|
|
|
|
(fn parse-op [op]
|
|
(let [[mode arg] (parse-mode-arg op)] {: mode : arg}))
|
|
|
|
; abl = $000000
|
|
; alx = $000000,X
|
|
(local op-pdat {})
|
|
(fn addr-page [addr] (math.floor (/ addr 0x10000)))
|
|
(fn op-pdat.patch [op env]
|
|
(local long-mode (match op.mode :abs :abl :abx :alx))
|
|
(when (and long-mode
|
|
(not= (type op.arg) :function)
|
|
(not= (addr-page (env:lookup-org op.arg))
|
|
(addr-page env.root-block.org)))
|
|
(set op.mode long-mode)))
|
|
|
|
(fn op-pdat.size [op env]
|
|
; TODO: handle 8-bit modes
|
|
(match op.mode
|
|
(where (or :sr :dp :dpx :dpy :idp :idx :idy :idl :idly :isy :rel)) 2
|
|
:imm8 2
|
|
:imm (match op.opcode
|
|
(where (or :cop :brk :sep :rep)) 2
|
|
_ 3)
|
|
(where (or :abs :abx :aby :ind :iax :rell :bm)) 3
|
|
(where (or :abl :alx :ial)) 4
|
|
nil 1
|
|
_ (error (.. "unknown mode " op.mode))))
|
|
|
|
(fn op-pdat.bytes [op env]
|
|
(local bytegen (. opcodes op.opcode))
|
|
(if bytegen
|
|
(let [opbyte (bytegen (if (= op.mode :imm8) :imm op.mode))
|
|
arg (if (= (type op.arg) :function) (op.arg env) op.arg)
|
|
argbytes
|
|
(if
|
|
(or (= op.mode :sr) (= op.mode :isy) (= op.mode :imm8)) (int8-to-bytes arg)
|
|
(= op.mode :bm) (.. (int8-to-bytes (. arg 1)) (int8-to-bytes (. arg 2)))
|
|
(and (= op.mode :imm) (= (op-pdat.size op env) 3)) (int16-to-bytes arg)
|
|
(and (= op.mode :imm) (= (op-pdat.size op env) 2)) (int8-to-bytes arg)
|
|
(= op.mode :rel) (int8-to-bytes (- (env:lookup-addr arg) (+ op.addr 2)))
|
|
(= op.mode :rell) (int16-to-bytes (- (env:lookup-addr arg) (+ op.addr 3)))
|
|
(= (op-pdat.size op env) 2) (int8-to-bytes (env:lookup-addr arg))
|
|
(= (op-pdat.size op env) 3) (int16-to-bytes (env:lookup-addr arg))
|
|
(= (op-pdat.size op env) 4) (int24-to-bytes (env:lookup-addr arg))
|
|
"")]
|
|
(if opbyte
|
|
(.. (int8-to-bytes opbyte) argbytes)
|
|
(error (.. op.opcode " doesn't support mode " op.mode))))
|
|
""))
|
|
|
|
{: opcodes : parse-op : op-pdat : addr-parser}
|