SpindleyQ/honeylisp
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Fix a couple bugs in z80 assembly, support addresses + function args

Browse source
This commit is contained in:
Jeremy Penner 2023-02-22 00:06:04 -05:00
parent 4f40b3851b
commit fb0c141653
1 changed files with 22 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
asm/z80.fnl
View file

@ -39,13 +39,6 @@
(fn opform [opcode matchers prefixgen] (fn opform [opcode matchers prefixgen]
(chain-op opcode #(try-parse-op $1 matchers prefixgen))) (chain-op opcode #(try-parse-op $1 matchers prefixgen)))
(fn is-addr? [param] (= (type param) :string))
(fn addr [param] (when (is-addr? param) {:addr param}))
(fn rel-addr [param] (when (is-addr? param) {:rel8 param}))
(fn num [param] (when (= (type param) :number) {:num param}))
(fn imm16 [param] (when (= (type param) :number) {:imm16 param}))
(fn imm8 [param] (when (= (type param) :number) {:imm8 param}))
(fn table-matcher [tbl key] (fn table-matcher [tbl key]
(let [lookup (collect [i val (ipairs tbl)] val (- i 1))] (let [lookup (collect [i val (ipairs tbl)] val (- i 1))]
(fn [param] (case (. lookup param) octet {key octet})))) (fn [param] (case (. lookup param) octet {key octet}))))
@ -55,6 +48,18 @@
#(when (argmatch [:hl] $1) {:reg 6}))) #(when (argmatch [:hl] $1) {:reg 6})))
(local rp (table-matcher [:bc :de :hl :sp] :rp)) (local rp (table-matcher [:bc :de :hl :sp] :rp))
(local rp2 (table-matcher [:bc :de :hl :af] :rp)) (local rp2 (table-matcher [:bc :de :hl :af] :rp))
(fn is-addr? [param] (and (= (type param) :string)
(not= param :ix) (not= param :iy)
(= (reg param) nil) (= (rp param) nil) (= (rp2 param) nil)))
(fn is-computed? [param] (= (type param) :function))
(fn is-number? [param] (= (type param) :number))
(fn rel-addr [param] (when (is-addr? param) {:rel8 param}))
(fn num [param] (when (or (is-number? param) (is-computed? param)) {:num param}))
(fn imm16 [param] (when (or (is-number? param) (is-computed? param) (is-addr? param)) {:imm16 param}))
(fn imm8 [param] (when (or (is-number? param) (is-computed? param)) {:imm8 param}))
(local addr imm16)
(fn im [arg] (match arg (fn im [arg] (match arg
0 {:im 0} 0 {:im 0}
1 {:im 2} 1 {:im 2}
@ -167,7 +172,7 @@
; ED prefix ; ED prefix
(opform :in [reg [:c]] #(when (not= $1.reg 6) (.. "\xed" (xyz 1 $1.reg 0)))) (opform :in [reg [:c]] #(when (not= $1.reg 6) (.. "\xed" (xyz 1 $1.reg 0))))
(opform :in [[:c]] #(.. "\xed" (xyz 1 6 0))) (opform :in [[:c]] #(.. "\xed" (xyz 1 6 0)))
(opform :out [reg [:c]] #(when (not= $1.reg 6) (.. "\xed" (xyz 1 $1.reg 1)))) (opform :out [[:c] reg] #(when (not= $1.reg 6) (.. "\xed" (xyz 1 $1.reg 1))))
(opform :out [[:c]] #(.. "\xed" (xyz 1 6 1))) (opform :out [[:c]] #(.. "\xed" (xyz 1 6 1)))
(opform :sbc [:hl rp] #(.. "\xed" (xpqz 1 $1.rp 0 2))) (opform :sbc [:hl rp] #(.. "\xed" (xpqz 1 $1.rp 0 2)))
(opform :adc [:hl rp] #(.. "\xed" (xpqz 1 $1.rp 1 2))) (opform :adc [:hl rp] #(.. "\xed" (xpqz 1 $1.rp 1 2)))
@ -222,19 +227,23 @@
(fn op-pdat.size [op env] (fn op-pdat.size [op env]
(+ (length op.prefix) (+ (length op.prefix)
(case op (case op
{: addr} 2
{: rel8} 1 {: rel8} 1
{: imm16} 2 {: imm16} 2
{: imm8} 1 {: imm8} 1
_ 0))) _ 0)))
(fn decode-number [param env]
(case (type param)
:number param
:string (env:lookup-addr param)
:function (param (setmetatable {} {:__index #(env:lookup-addr $2)}) env)))
(fn op-pdat.bytes [op env] (fn op-pdat.bytes [op env]
(.. op.prefix (.. op.prefix
(case op (case op
{: addr} (int16-to-bytes (env:lookup-addr addr)) {: rel8} (int8-to-bytes (- (env:lookup-addr rel8) (+ op.addr 2)))
{: rel8} (int8-to-bytes (- (env:lookup-addr rel8) op.addr)) {: imm16} (int16-to-bytes (decode-number imm16 env))
{: imm16} (int16-to-bytes imm16) {: imm8} (int8-to-bytes (decode-number imm8 env))
{: imm8} (int8-to-bytes imm8)
_ ""))) _ "")))
{: opcodes : parse-op : op-pdat : try-parse-op} {: opcodes : parse-op : op-pdat : try-parse-op}