honeylisp/asm/65816.fnl

(local {: int8-to-bytes : int16-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 :ial] [: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 :iax] [: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 :abs] [: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))))))

(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 parse-mode-arg [op]
  (match op
    (where [mvx srcbank dstbank]
           (= (type srcbank) :number) (= (type dstbank) :number) (= (mvx:sub 1 2) :mv))
       [:bm [srcbank dstbank]]
    (where [_ imm] (or (= (type imm) :number) (= (type imm) :function))) [:imm imm]
    [_ offset :s] [:sr offset]
    [_ [[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]
    ; 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)))))

; 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.opcode :abs :abl :abx :alx))
  (when (and long-mode (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
    :imm 3 ;; todo: support 8-bit immediate mode
    (where (or :abs :abx :aby :ind :iax :rell :bm)) 3
    (where (or :abl :alx :ial)) 4
    nil 1
    _ (error (.. "unknown mode " op.mode))))
(fn int24-to-bytes [i] (.. (int8-to-bytes (addr-page i)) (int16-to-bytes (bit.band i 0xffff))))

(fn op-pdat.bytes [op env]
  (local bytegen (. opcodes op.opcode))
  (if bytegen
    (let [opbyte (bytegen op.mode)
          argbytes
          (if
            (or (= op.mode :sr) (= op.mode :isy)) (int8-to-bytes op.arg)
            (= op.mode :bm) (.. (int8-to-bytes (. op.arg 1)) (int8-to-bytes (. op.arg 2)))
            (and (= op.mode :imm) (= (type op.arg) "function"))
              (int16-to-bytes (op.arg env))
            (= op.mode :imm) (int16-to-bytes op.arg)
            (= op.mode :rel)
              (int8-to-bytes (- (env:lookup-addr op.arg) (+ op.addr 2)))
            (= op.mode :rell)
              (int16-to-bytes (- (env:lookup-addr op.arg) (+ op.addr 3)))
            (= (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))
            (= (op-pdat.size op) 4) (int24-to-bytes (env:lookup-addr op.arg))
            "")]
      (if opbyte
        (.. (int8-to-bytes opbyte) argbytes)
        (error (.. op.opcode " doesn't support mode " op.mode))))
    ""))

{: opcodes : parse-mode-arg : op-pdat : addr-parser}