From 16d88efbf120febf54b4b720314285a307ffb7c2 Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Mon, 2 Aug 2021 19:40:31 -0400 Subject: [PATCH] We can add numbers!! (confirmed in MAME debugger) --- asm/65816.fnl | 21 +++++++++++---------- game/files.fnl | 2 +- link/mame.fnl | 2 +- neutgs/init.fnl | 21 +++++++++++++++++++++ ssc/init.fnl | 20 ++++++++++++++------ 5 files changed, 48 insertions(+), 18 deletions(-) create mode 100644 neutgs/init.fnl diff --git a/asm/65816.fnl b/asm/65816.fnl index 4899952..f0dea45 100644 --- a/asm/65816.fnl +++ b/asm/65816.fnl @@ -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) diff --git a/game/files.fnl b/game/files.fnl index 2735844..357563d 100644 --- a/game/files.fnl +++ b/game/files.fnl @@ -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] diff --git a/link/mame.fnl b/link/mame.fnl index 4e234b8..036d685 100644 --- a/link/mame.fnl +++ b/link/mame.fnl @@ -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) diff --git a/neutgs/init.fnl b/neutgs/init.fnl new file mode 100644 index 0000000..43e9106 --- /dev/null +++ b/neutgs/init.fnl @@ -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) diff --git a/ssc/init.fnl b/ssc/init.fnl index c4a07a8..1ced5d7 100644 --- a/ssc/init.fnl +++ b/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