We can add numbers!! (confirmed in MAME debugger)
This commit is contained in:
parent
e37a7a2153
commit
16d88efbf1
|
@ -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)
|
||||||
|
|
|
@ -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]
|
||||||
|
|
|
@ -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
21
neutgs/init.fnl
Normal 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)
|
20
ssc/init.fnl
20
ssc/init.fnl
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue