129 lines
4.5 KiB
Fennel
129 lines
4.5 KiB
Fennel
(local {: int8-to-bytes : int16-to-bytes} (require "lib.util"))
|
|
|
|
(local opcodes {})
|
|
|
|
; op mode arg
|
|
; single-byte ops
|
|
(let [ops
|
|
{:php 0x08 :plp 0x28 :pha 0x48 :pla 0x68 :dey 0x88 :tay 0xa8 :iny 0xc8 :inx 0xe8
|
|
:clc 0x18 :sec 0x38 :cli 0x58 :sei 0x78 :tya 0x98 :clv 0xb8 :cld 0xd8 :sed 0xf8
|
|
:txa 0x8a :txs 0x9a :tax 0xaa :tsx 0xba :dex 0xca :nop 0xea :rti 0x40 :rts 0x60}]
|
|
(each [opcode byte (pairs ops)]
|
|
(tset opcodes opcode (fn [mode] (if mode nil byte)))))
|
|
(set opcodes.brk (fn [mode] (if (or (= mode :imm) (= mode nil)) 0x00 nil)))
|
|
|
|
; branch ops
|
|
(let [ops {:bpl 0x10 :bmi 0x30 :bvc 0x50 :bvs 0x70 :bcc 0x90 :bcs 0xb0 :bne 0xd0 :beq 0xf0}]
|
|
(each [opcode byte (pairs ops)]
|
|
(tset opcodes opcode (fn [mode] (if (= mode :rel) byte nil)))))
|
|
(set opcodes.jsr (fn [mode] (if (= mode :abs) 0x20 nil)))
|
|
|
|
; aaabbbcc ops
|
|
(fn aaabbbcc [aaa cc modemap]
|
|
(local base (bit.bor cc (bit.lshift aaa 5)))
|
|
(fn [mode]
|
|
(local bbb (. modemap mode))
|
|
(if bbb (bit.bor base (bit.lshift bbb 2)) nil)))
|
|
|
|
(fn indexed-modes [...]
|
|
(let [modemap {}]
|
|
(each [index mode (pairs [...])]
|
|
(tset modemap mode (- index 1)))
|
|
modemap))
|
|
|
|
(fn without-modes [modemap ...]
|
|
(let [newmodemap (lume.clone modemap)]
|
|
(each [_ mode (pairs [...])]
|
|
(tset newmodemap mode nil))
|
|
newmodemap))
|
|
|
|
(fn only-modes [modemap ...]
|
|
(let [newmodemap {}]
|
|
(each [_ mode (pairs [...])]
|
|
(tset newmodemap mode (. modemap mode)))
|
|
newmodemap))
|
|
|
|
; cc=1 ops
|
|
(let [cc1-modes (indexed-modes :zp-x* :zp :imm :abs :zp*-y :zp-x :abs-y :abs-x)
|
|
ops {:ora 0 :and 1 :eor 2 :adc 3 :lda 5 :cmp 6 :sbc 7}]
|
|
(each [opcode aaa (pairs ops)]
|
|
(tset opcodes opcode (aaabbbcc aaa 1 cc1-modes))
|
|
(tset opcodes :sta (aaabbbcc 4 1 (without-modes cc1-modes :imm)))))
|
|
; cc=2 ops
|
|
(let [cc2-modes (indexed-modes nil :zp :a :abs nil :zp-x nil :abs-x)]
|
|
(each [opcode aaa (pairs {:asl 0 :rol 1 :lsr 2 :ror 3})]
|
|
(tset opcodes opcode (aaabbbcc aaa 2 cc2-modes))
|
|
(each [opcode aaa (pairs {:dec 6 :inc 7})]
|
|
(tset opcodes opcode (aaabbbcc aaa 2 (without-modes cc2-modes :a))))))
|
|
(tset opcodes :stx (aaabbbcc 4 2 (indexed-modes nil :zp nil :abs nil nil :zp-y)))
|
|
(tset opcodes :ldx (aaabbbcc 5 2 (indexed-modes :imm :zp nil :abs nil nil :zp-y nil :abs-y)))
|
|
|
|
; cc=0 ops
|
|
(let [cc0-modes (indexed-modes :imm :zp nil :abs nil :zp-x nil :abs-x)]
|
|
(tset opcodes :bit (aaabbbcc 1 0 (only-modes cc0-modes :zp :abs)))
|
|
(tset opcodes :sty (aaabbbcc 4 0 (only-modes cc0-modes :zp :abs :zp-x)))
|
|
(tset opcodes :ldy (aaabbbcc 5 0 cc0-modes))
|
|
(each [opcode aaa (pairs {:cpy 6 :cpx 7})]
|
|
(tset opcodes opcode (aaabbbcc aaa 0 (only-modes cc0-modes :imm :zp :abs)))))
|
|
(tset opcodes :jmp (fn [mode] (match mode :abs 0x4c :abs* 0x6c _ nil)))
|
|
|
|
(fn parse-mode-arg [op]
|
|
(match op
|
|
[_ :a] [:a nil]
|
|
([_ imm] ? (or (= (type imm) "number") (= (type imm) "function"))) [:imm imm]
|
|
([opcode addr] ? (and (= (type addr) "string") (= (opcode:sub 1 1) "b"))) [:rel addr] ; branch
|
|
[_ addr :x] [:addr-x addr]
|
|
[_ [addr] :y] [:zp*-y addr]
|
|
[_ addr :y] [:addr-y addr]
|
|
[_ [addr :x]] [:zp-x* addr]
|
|
([_ addr] ? (= (type addr) "string")) [:addr addr]
|
|
[_ [addr]] [:abs* addr]
|
|
[_] [nil nil]
|
|
_ (error (.. "Unrecognized syntax" (fv op)))))
|
|
|
|
(fn parse-op [op]
|
|
(let [[mode arg] (parse-mode-arg op)] {: mode : arg}))
|
|
|
|
(local op-pdat {})
|
|
|
|
(fn is-zp? [env name]
|
|
(match (env:lookup-org name)
|
|
org (< org 0x100)))
|
|
|
|
(fn op-pdat.patch [op env]
|
|
(when (and op.mode (= (op.mode:sub 1 4) :addr))
|
|
(let [zp-mode (.. :zp (op.mode:sub 5))
|
|
abs-mode (.. :abs (op.mode:sub 5))
|
|
is-zp (and ((. opcodes op.opcode) zp-mode) (is-zp? env op.arg))]
|
|
(set op.mode (if is-zp zp-mode abs-mode)))))
|
|
|
|
(fn op-pdat.size [{: mode}]
|
|
(if
|
|
(or (= mode nil) (= mode :a)) 1
|
|
(= (mode:sub 1 3) :abs) 3
|
|
2))
|
|
|
|
(fn op-pdat.bytes [op env]
|
|
(local bytegen (. opcodes op.opcode))
|
|
; (pp op)
|
|
(if bytegen
|
|
(let [opbyte (bytegen op.mode)
|
|
argbytes
|
|
(if
|
|
(and (= op.mode :imm) (= (type op.arg) "function"))
|
|
(int8-to-bytes (op.arg env))
|
|
|
|
(= op.mode :imm) (int8-to-bytes op.arg)
|
|
(= op.mode :rel)
|
|
(int8-to-bytes (- (env:lookup-addr op.arg) (+ op.addr 2)))
|
|
(= (op-pdat.size op) 2) (int8-to-bytes (env:lookup-addr op.arg))
|
|
(= (op-pdat.size op) 3) (int16-to-bytes (env:lookup-addr op.arg))
|
|
"")]
|
|
(if opbyte
|
|
(.. (int8-to-bytes opbyte) argbytes)
|
|
(error (.. op.opcode " doesn't support mode " op.mode))))
|
|
""))
|
|
|
|
|
|
{: opcodes : op-pdat : parse-op}
|