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]
|
||||
(= (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]
|
||||
(where [_ imm] (or (= (type imm) :number) (= (type imm) :function))) [:imm imm]
|
||||
[_ [[addr]] :y] [:idly addr]
|
||||
[_ [addr :s] :y] [:isy addr]
|
||||
[_ [addr] :y] [:idy addr]
|
||||
|
@ -98,7 +98,9 @@
|
|||
; 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
|
||||
: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 :abl :alx :ial)) 4
|
||||
nil 1
|
||||
|
@ -115,14 +117,13 @@
|
|||
(= 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))
|
||||
(and (= op.mode :imm) (= (op-pdat.size op env) 3)) (int16-to-bytes op.arg)
|
||||
(and (= op.mode :imm) (= (op-pdat.size op env) 2)) (int8-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 env) 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 env) 4) (int24-to-bytes (env:lookup-addr op.arg))
|
||||
"")]
|
||||
(if opbyte
|
||||
(.. (int8-to-bytes opbyte) argbytes)
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
(local files (util.hot-table ...))
|
||||
|
||||
(local default-filename "bitsy/game.json")
|
||||
(local default-filename "neutgs/game.json")
|
||||
|
||||
(local encoded-tile-fields [:gfx :mask])
|
||||
(fn convert [tile field method]
|
||||
|
|
|
@ -141,7 +141,7 @@
|
|||
(bencode.encode addr-to-bytes)))
|
||||
(fn Machine.launch [self prg]
|
||||
(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.coro-eval [self code ?handlers]
|
||||
(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)
|
||||
[:ply])
|
||||
|
||||
(fn Ssc.defining? [self] (> (length self.locals) 0))
|
||||
|
||||
(fn countiter [minmax ?max]
|
||||
(let [min (if ?max minmax 1)
|
||||
max (or ?max minmax)]
|
||||
|
@ -73,7 +75,7 @@
|
|||
(let [compiled-left (self:compile-expr left)
|
||||
push-left (when (not= (type right) :number) (self:push))
|
||||
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))]
|
||||
[:block
|
||||
compiled-left
|
||||
|
@ -87,7 +89,9 @@
|
|||
drop-left]))
|
||||
|
||||
(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)))
|
||||
:do (fn [self ...] (lume.concat [:block] (icollect [i (countiter (select :# ...))] (self:compile-expr (select i ...)))))
|
||||
:let (fn [self bindings ...]
|
||||
|
@ -107,7 +111,7 @@
|
|||
-1 [:dec] -2 [:block [:dec] [:dec]]
|
||||
(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]]
|
||||
_ [: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)
|
||||
:- (lambda [self first ...]
|
||||
(let [block [:block (self:compile-expr first)]
|
||||
|
@ -121,7 +125,7 @@
|
|||
-1 [:inc] -2 [:block [:inc] [:inc]]
|
||||
(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]]
|
||||
_ [: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))
|
||||
:= (lambda [self lhs rhs] (boolop self lhs rhs :beq))
|
||||
:not= (lambda [self lhs rhs] (boolop self lhs rhs :bne))
|
||||
|
@ -142,7 +146,7 @@
|
|||
(when ?iffalse [(self:compile-expr ?iffalse)])
|
||||
[:-finished-]))
|
||||
:fn (lambda [self name args ...]
|
||||
(assert (= (length self.locals) 0))
|
||||
(assert (not (self:defining?)))
|
||||
(set self.locals (lume.concat args [[:tmp]]))
|
||||
(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)
|
||||
|
@ -156,7 +160,7 @@
|
|||
(var offset nil)
|
||||
(for [i 1 (length self.locals)]
|
||||
(when (= (. self.locals i) symbol)
|
||||
(set offset (* 2 (- (length self.locals) i)))))
|
||||
(set offset (+ 1 (* 2 (- (length self.locals) i))))))
|
||||
offset)
|
||||
|
||||
(fn Ssc.compile-expr [self expr]
|
||||
|
@ -178,4 +182,8 @@
|
|||
(self:compile-expr (select i ...)))
|
||||
self)
|
||||
|
||||
(fn Ssc.assemble [self]
|
||||
(self.prg:assemble)
|
||||
self.prg)
|
||||
|
||||
Ssc
|
||||
|
|
Loading…
Reference in a new issue