We can add numbers!! (confirmed in MAME debugger)

This commit is contained in:
Jeremy Penner 2021-08-02 19:40:31 -04:00
parent e37a7a2153
commit 16d88efbf1
5 changed files with 48 additions and 18 deletions

View file

@ -55,8 +55,8 @@
(where [mvx srcbank dstbank] (where [mvx srcbank dstbank]
(= (type srcbank) :number) (= (type dstbank) :number) (= (mvx:sub 1 2) :mv)) (= (type srcbank) :number) (= (type dstbank) :number) (= (mvx:sub 1 2) :mv))
[:bm [srcbank dstbank]] [:bm [srcbank dstbank]]
(where [_ imm] (or (= (type imm) :number) (= (type imm) :function))) [:imm imm]
[_ offset :s] [:sr offset] [_ offset :s] [:sr offset]
(where [_ imm] (or (= (type imm) :number) (= (type imm) :function))) [:imm imm]
[_ [[addr]] :y] [:idly addr] [_ [[addr]] :y] [:idly addr]
[_ [addr :s] :y] [:isy addr] [_ [addr :s] :y] [:isy addr]
[_ [addr] :y] [:idy addr] [_ [addr] :y] [:idy addr]
@ -98,7 +98,9 @@
; TODO: handle 8-bit modes ; TODO: handle 8-bit modes
(match op.mode (match op.mode
(where (or :sr :dp :dpx :dpy :idp :idx :idy :idl :idly :isy :rel)) 2 (where (or :sr :dp :dpx :dpy :idp :idx :idy :idl :idly :isy :rel)) 2
:imm 3 ;; todo: support 8-bit immediate mode :imm (match op.opcode
(where (or :cop :brk :sep :rep)) 2
_ 3) ;; todo: support 8-bit immediate mode
(where (or :abs :abx :aby :ind :iax :rell :bm)) 3 (where (or :abs :abx :aby :ind :iax :rell :bm)) 3
(where (or :abl :alx :ial)) 4 (where (or :abl :alx :ial)) 4
nil 1 nil 1
@ -115,14 +117,13 @@
(= op.mode :bm) (.. (int8-to-bytes (. op.arg 1)) (int8-to-bytes (. op.arg 2))) (= op.mode :bm) (.. (int8-to-bytes (. op.arg 1)) (int8-to-bytes (. op.arg 2)))
(and (= op.mode :imm) (= (type op.arg) "function")) (and (= op.mode :imm) (= (type op.arg) "function"))
(int16-to-bytes (op.arg env)) (int16-to-bytes (op.arg env))
(= op.mode :imm) (int16-to-bytes op.arg) (and (= op.mode :imm) (= (op-pdat.size op env) 3)) (int16-to-bytes op.arg)
(= op.mode :rel) (and (= op.mode :imm) (= (op-pdat.size op env) 2)) (int8-to-bytes op.arg)
(int8-to-bytes (- (env:lookup-addr op.arg) (+ op.addr 2))) (= op.mode :rel) (int8-to-bytes (- (env:lookup-addr op.arg) (+ op.addr 2)))
(= op.mode :rell) (= op.mode :rell) (int16-to-bytes (- (env:lookup-addr op.arg) (+ op.addr 3)))
(int16-to-bytes (- (env:lookup-addr op.arg) (+ op.addr 3))) (= (op-pdat.size op env) 2) (int8-to-bytes (env:lookup-addr op.arg))
(= (op-pdat.size op) 2) (int8-to-bytes (env:lookup-addr op.arg)) (= (op-pdat.size op env) 3) (int16-to-bytes (env:lookup-addr op.arg))
(= (op-pdat.size op) 3) (int16-to-bytes (env:lookup-addr op.arg)) (= (op-pdat.size op env) 4) (int24-to-bytes (env:lookup-addr op.arg))
(= (op-pdat.size op) 4) (int24-to-bytes (env:lookup-addr op.arg))
"")] "")]
(if opbyte (if opbyte
(.. (int8-to-bytes opbyte) argbytes) (.. (int8-to-bytes opbyte) argbytes)

View file

@ -4,7 +4,7 @@
(local files (util.hot-table ...)) (local files (util.hot-table ...))
(local default-filename "bitsy/game.json") (local default-filename "neutgs/game.json")
(local encoded-tile-fields [:gfx :mask]) (local encoded-tile-fields [:gfx :mask])
(fn convert [tile field method] (fn convert [tile field method]

View file

@ -141,7 +141,7 @@
(bencode.encode addr-to-bytes))) (bencode.encode addr-to-bytes)))
(fn Machine.launch [self prg] (fn Machine.launch [self prg]
(self:eval "(manager.machine:soft_reset)") (self:eval "(manager.machine:soft_reset)")
(self:eval (string.format "(emu.keypost \"CALL-151\\n %xG\\n\")" (prg:lookup-addr prg.start-symbol)))) (self:eval (string.format "(emu.keypost \"\n\n\n\nCALL-151\\n %xG\\n\")" (prg:lookup-addr prg.start-symbol))))
(fn Machine.reboot [self] (self:eval "(manager.machine:hard_reset)")) (fn Machine.reboot [self] (self:eval "(manager.machine:hard_reset)"))
(fn Machine.coro-eval [self code ?handlers] (fn Machine.coro-eval [self code ?handlers]
(var result nil) (var result nil)

21
neutgs/init.fnl Normal file
View file

@ -0,0 +1,21 @@
(local Ssc (require :ssc))
(import-macros {:sss ! : compile} :ssc.macros)
(local ssc (Ssc))
(set ssc.prg.start-symbol :boot)
(compile ssc
(org 0xc00)
(asm
boot
(clc) (xce) (rep 0x30) ; disable emulation mode, 16-bit index registers
(jsr main)
(sec) (xce) ;re-enter emulation mode
(rts))
(fn printnum (num) ; TODO
)
(fn add (lhs rhs) (+ lhs rhs))
(fn main ()
(printnum (add 1 2)))
)
(ssc:assemble)

View file

@ -58,6 +58,8 @@
(tset self.locals (length self.locals) nil) (tset self.locals (length self.locals) nil)
[:ply]) [:ply])
(fn Ssc.defining? [self] (> (length self.locals) 0))
(fn countiter [minmax ?max] (fn countiter [minmax ?max]
(let [min (if ?max minmax 1) (let [min (if ?max minmax 1)
max (or ?max minmax)] max (or ?max minmax)]
@ -73,7 +75,7 @@
(let [compiled-left (self:compile-expr left) (let [compiled-left (self:compile-expr left)
push-left (when (not= (type right) :number) (self:push)) push-left (when (not= (type right) :number) (self:push))
compiled-compare (if (not push-left) [:cmp right] compiled-compare (if (not push-left) [:cmp right]
[:block push-left (self:compile-expr right) [:cmp 0 :s]]) [:block push-left (self:compile-expr right) [:cmp 1 :s]])
drop-left (when push-left (self:drop))] drop-left (when push-left (self:drop))]
[:block [:block
compiled-left compiled-left
@ -87,7 +89,9 @@
drop-left])) drop-left]))
(set Ssc.forms (set Ssc.forms
{:asm (fn [self ...] [:block ...]) {:asm (fn [self ...]
(if (self:defining?) [:block ...]
(self.org:append ...)))
:org (lambda [self org] (set self.org (self.prg:org org))) :org (lambda [self org] (set self.org (self.prg:org org)))
:do (fn [self ...] (lume.concat [:block] (icollect [i (countiter (select :# ...))] (self:compile-expr (select i ...))))) :do (fn [self ...] (lume.concat [:block] (icollect [i (countiter (select :# ...))] (self:compile-expr (select i ...)))))
:let (fn [self bindings ...] :let (fn [self bindings ...]
@ -107,7 +111,7 @@
-1 [:dec] -2 [:block [:dec] [:dec]] -1 [:dec] -2 [:block [:dec] [:dec]]
(where val (= (type val) :number)) [:block [:clc] [:adc val]] (where val (= (type val) :number)) [:block [:clc] [:adc val]]
(where sym (= (type sym) :string) (self:local-offset sym)) [:block [:clc] [:adc (self:local-offset sym) :s]] (where sym (= (type sym) :string) (self:local-offset sym)) [:block [:clc] [:adc (self:local-offset sym) :s]]
_ [:block (self:push) (self:compile-expr val) [:clc] [:adc 0 :s] (self:drop)])))) _ [:block (self:push) (self:compile-expr val) [:clc] [:adc 1 :s] (self:drop)]))))
block) block)
:- (lambda [self first ...] :- (lambda [self first ...]
(let [block [:block (self:compile-expr first)] (let [block [:block (self:compile-expr first)]
@ -121,7 +125,7 @@
-1 [:inc] -2 [:block [:inc] [:inc]] -1 [:inc] -2 [:block [:inc] [:inc]]
(where val (= (type val) :number)) [:block [:sec] [:sbc val]] (where val (= (type val) :number)) [:block [:sec] [:sbc val]]
(where sym (= (type sym) :string) (self:local-offset sym)) [:block [:sec] [:sbc (self:local-offset sym) :s]] (where sym (= (type sym) :string) (self:local-offset sym)) [:block [:sec] [:sbc (self:local-offset sym) :s]]
_ [:block (self:push) (self:compile-expr val) [:sec] [:sbc 0 :s] (self:drop)]))))) _ [:block (self:push) (self:compile-expr val) [:sec] [:sbc 1 :s] (self:drop)])))))
block)) block))
:= (lambda [self lhs rhs] (boolop self lhs rhs :beq)) := (lambda [self lhs rhs] (boolop self lhs rhs :beq))
:not= (lambda [self lhs rhs] (boolop self lhs rhs :bne)) :not= (lambda [self lhs rhs] (boolop self lhs rhs :bne))
@ -142,7 +146,7 @@
(when ?iffalse [(self:compile-expr ?iffalse)]) (when ?iffalse [(self:compile-expr ?iffalse)])
[:-finished-])) [:-finished-]))
:fn (lambda [self name args ...] :fn (lambda [self name args ...]
(assert (= (length self.locals) 0)) (assert (not (self:defining?)))
(set self.locals (lume.concat args [[:tmp]])) (set self.locals (lume.concat args [[:tmp]]))
(tset self.functions name {:arity (length args) : args :org self.org}) (tset self.functions name {:arity (length args) : args :org self.org})
; todo: maybe handle mutually recursive functions? (compile-expr only has access to currently-defined functions) ; todo: maybe handle mutually recursive functions? (compile-expr only has access to currently-defined functions)
@ -156,7 +160,7 @@
(var offset nil) (var offset nil)
(for [i 1 (length self.locals)] (for [i 1 (length self.locals)]
(when (= (. self.locals i) symbol) (when (= (. self.locals i) symbol)
(set offset (* 2 (- (length self.locals) i))))) (set offset (+ 1 (* 2 (- (length self.locals) i))))))
offset) offset)
(fn Ssc.compile-expr [self expr] (fn Ssc.compile-expr [self expr]
@ -178,4 +182,8 @@
(self:compile-expr (select i ...))) (self:compile-expr (select i ...)))
self) self)
(fn Ssc.assemble [self]
(self.prg:assemble)
self.prg)
Ssc Ssc