diff --git a/asm/65816.fnl b/asm/65816.fnl index 2352c41..9f344db 100644 --- a/asm/65816.fnl +++ b/asm/65816.fnl @@ -65,6 +65,7 @@ (= (type srcbank) :number) (= (type dstbank) :number) (= (mvx:sub 1 2) :mv)) [:bm [dstbank srcbank]] ; encoded backwards for some reason [_ offset :s] [:sr offset] + [_ :#8 imm] [:imm8 imm] (where [_ imm] (or (= (type imm) :number) (= (type imm) :function))) [:imm imm] [_ [[addr]] :y] [:idly addr] [_ [addr :s] :y] [:isy addr] @@ -109,9 +110,10 @@ ; TODO: handle 8-bit modes (match op.mode (where (or :sr :dp :dpx :dpy :idp :idx :idy :idl :idly :isy :rel)) 2 + :imm8 2 :imm (match op.opcode (where (or :cop :brk :sep :rep)) 2 - _ 3) ;; todo: support 8-bit immediate mode + _ 3) (where (or :abs :abx :aby :ind :iax :rell :bm)) 3 (where (or :abl :alx :ial)) 4 nil 1 @@ -120,11 +122,11 @@ (fn op-pdat.bytes [op env] (local bytegen (. opcodes op.opcode)) (if bytegen - (let [opbyte (bytegen op.mode) + (let [opbyte (bytegen (if (= op.mode :imm8) :imm op.mode)) arg (if (= (type op.arg) :function) (op.arg env) op.arg) argbytes (if - (or (= op.mode :sr) (= op.mode :isy)) (int8-to-bytes arg) + (or (= op.mode :sr) (= op.mode :isy) (= op.mode :imm8)) (int8-to-bytes arg) (= op.mode :bm) (.. (int8-to-bytes (. arg 1)) (int8-to-bytes (. arg 2))) (and (= op.mode :imm) (= (op-pdat.size op env) 3)) (int16-to-bytes arg) (and (= op.mode :imm) (= (op-pdat.size op env) 2)) (int8-to-bytes arg) diff --git a/asm/asm.fnl b/asm/asm.fnl index 47f79e2..894c0c2 100644 --- a/asm/asm.fnl +++ b/asm/asm.fnl @@ -76,11 +76,11 @@ (table.remove dats 1) (parse-dats (new-block block.last-symbol) dats))) - (fn dat-parser.db [db] {:type :var :init (. db 2) :size 1}) - (fn dat-parser.dw [dw] {:type :var :init (. dw 2) :size 2}) - (fn dat-parser.dl [dl] {:type :var :init (. dl 4) :size 4}) - (fn dat-parser.bytes [bytes] {:type :raw :bytes (. bytes 2)}) - (fn dat-parser.ref [ref] {:type :ref :target (. ref 2)}) + (fn dat-parser.db [db] {:type :var :init (. db 2) :size 1}) + (fn dat-parser.dw [dw] {:type :var :init (. dw 2) :size 2}) + (fn dat-parser.dl [dl] {:type :var :init (. dl 2) :size 4}) + (fn dat-parser.bytes [[_ bytes]] {:type :raw :bytes (if (= (type bytes) :table) (string.char (table.unpack bytes)) bytes)}) + (fn dat-parser.ref [ref] {:type :ref :target (. ref 2)}) (fn dat-parser.flatten [flat block] (parse-dats block (lume.slice flat 2)) nil) diff --git a/editor/replview.fnl b/editor/replview.fnl index f7a2e6c..dec7b74 100644 --- a/editor/replview.fnl +++ b/editor/replview.fnl @@ -1,5 +1,5 @@ (local util (require :lib.util)) -(local {: attach-imstate : textbox} (util.require :editor.imstate)) +(local {: attach-imstate : textbox : textbutton : mouse-inside} (util.require :editor.imstate)) (local View (require :core.view)) (local style (require :core.style)) @@ -24,8 +24,14 @@ (fn ReplView.append [self line] (table.insert self.log line)) -(fn ReplView.draw-cmd [{: cmd} view x y] +(fn ReplView.draw-cmd [{: cmd} view x y iline] (renderer.draw_text style.font cmd x y style.text) + (when (mouse-inside x y view.size.x (style.font:get_height)) + (when (textbutton view :X (+ x view.size.x -35) y) + (table.remove view.log iline) + (table.remove view.log iline)) + (when (textbutton view :! (+ x view.size.x -60) y) + (view:submit cmd))) (+ (style.font:get_height) style.padding.y)) (fn ReplView.submit [self ?cmd] @@ -46,7 +52,7 @@ ; note: then offscreen items can't be focussed without further effort ; todo: draw line numbers (each [i line (ipairs self.log)] - (let [h (line:draw self x y)] + (let [h (line:draw self x y i)] (set y (+ y h)) (set rendered-h (+ rendered-h h)))) diff --git a/link/init.fnl b/link/init.fnl index 1655ade..b04d6e2 100644 --- a/link/init.fnl +++ b/link/init.fnl @@ -3,7 +3,7 @@ (fn [self name] (set self.machine (require (.. "link." name))) (set self.name name)) - :types [:serial :tape :mame]}) + :types [:serial :tape :mame :udpdebug]}) (local serial (require :link.serial)) (link:switch (if (and (pcall #(serial:connect)) (serial:connected?)) :serial :mame)) diff --git a/link/udpdebug.fnl b/link/udpdebug.fnl new file mode 100644 index 0000000..e610007 --- /dev/null +++ b/link/udpdebug.fnl @@ -0,0 +1,77 @@ +(local core (require :core)) +(local socket (require :socket)) +(local {: int16-to-bytes : int32-to-bytes : lo} (require :lib.util)) + +(local config { + :host "pi.local" + :port 6502 +}) + +{:cmd { + :write 0 + :read 1 + :jmp 2 + :pause 3 + :ping 4 + } + :response { + :ack 0 + :data 1 + } + :pending {} + :msgid 0 + :connect + (fn [self ?port ?host] + (when (not self.connection) + (local [port host] [(or ?port config.port) (or ?host config.host)]) + (set self.connection (assert (socket.udp))) + (assert (self.connection:setpeername host port)) + (self.connection:settimeout 0) + (core.add_thread #(while (self:connected?) (self:receive) (coroutine.yield)) self.connection))) + :connected? (fn [self] (not= self.connection nil)) + :disconnect + (fn [self] + (when self.connection + (self.connection:close) + (set self.connection nil) + (set self.pending {}))) + :next-msgid + (fn [self] + (set self.msgid (lo (+ self.msgid 1))) + self.msgid) + :send + (fn [self cmd ?data ?callback] + (let [msgid (self:next-msgid) + msg (.. (string.char msgid cmd) (or ?data ""))] + (when ?callback (tset self.pending msgid ?callback)) + (self.connection:send msg))) + :receive + (fn [self] + (when self.connection + (let [data (self.connection:receive)] + (when data + (let [msgid (string.byte (data:sub 1 1)) + cmd (string.byte (data:sub 2 2)) + pendingfn (. self.pending msgid)] + (when pendingfn + (tset self.pending msgid nil) + (pendingfn self cmd (data:sub 3)))))))) + :jump (fn [self addr] (self:send self.cmd.jmp (int32-to-bytes addr))) + ; todo: break up into multiple calls + :read + (fn [self addr len] + (let [coro (coroutine.running)] + (self:send self.cmd.read (.. (int32-to-bytes addr) + (int16-to-bytes len)) + #(coroutine.resume coro $3)) + (coroutine.yield))) + :write + (fn [self addr data] + (let [coro (coroutine.running)] + (self:send self.cmd.write (.. (int32-to-bytes addr) + (int16-to-bytes (length data)) + data) + #(coroutine.resume coro $3)) + (coroutine.yield))) + :launch (fn [self prg] (self:jump (prg:lookup-addr prg.start-symbol))) +} diff --git a/neutgs/game.json b/neutgs/game.json index 6591162..34662eb 100644 --- a/neutgs/game.json +++ b/neutgs/game.json @@ -1 +1 @@ -{"tiles":[{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00F0FF0F0F0F0F0F0F0F0F0F0F0F00F0F0F0F0F0FF0F0F0F0F0F0F0F00A0A0F0F0F0F0F0F0A0AF0F0F0F00A0A0A0A0A0A0F0F0A0A0A0A0A0AF00A0A0A0A0A0A0A0A0A0A0A0A0A0A0A0AF00A0A0A0A0A0A0F0F0A0A0A0A0A0AF0F0F0F00A0A0F0F0F0F0F0F0A0AF0F0F0F0F0F0F0F00F0F0F0F0F0FF0F0F0F0F0F0F0F0F0F0F0F00F0FF0F0F0F0F0F0F0"},{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00808F0F0F0F0F0F0F0F0F0F0F0F0080808080808F0F0F0F0F0F0F0F008080208020802080808F0F0F0F00808080808020802080808080808F008080808080808080808080808080808F00808080808080808080808080808F0F0F0F008080808020802080208F0F0F0F0F0F0F0F0080808020802F0F0F0F0F0F0F0F0F0F0F0F00808F0F0F0F0F0F0F0"},{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00904F0F0F0F0F0F0F0F0F0F0F0F0040409090404F0F0F0F0F0F0F0F009090904040909090404F0F0F0F00909040909090404090909040909F004040909040409090904040909040409F00904090904040404090904090909F0F0F0F004090909090904090904F0F0F0F0F0F0F0F0040409090404F0F0F0F0F0F0F0F0F0F0F0F00409F0F0F0F0F0F0F0"},{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F00707F0F0F0F0F0F0F0F0F0F0F0F0070707070707F0F0F0F0F0F0F0F007070707070707070707F0F0F0F00707070707070707070707070707F00707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070303070707070707070707070707030303030307070707070707070707030303F00303030307070707070703030303F0F0F0F003030303070703030303F0F0F0F0F0F0F0F0030303030303F0F0F0F0F0F0F0F0F0F0F0F00303F0F0F0F0F0F0F0"}],"platform":"iigs","levels":[{"loadword":"","map":"000000000000000000000000000000000000000000000000000000000000000000000000000000000000002000000000200000000000000000000000000000400000000040000000000000000000000000000040000020204000000000000000000000000000004000004000000000000000000000000000000000402020400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000","tickword":"","moveword":"","objects":[]}],"tilesets":{"jaye-tileset":"gfx","neut-tileset":"neut"}} \ No newline at end of file +{"tiles":[{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00F0FF0F0F0F0F0F0F0F0F0F0F0F00F0F0F0F0F0FF0F0F0F0F0F0F0F00A0A0F0F0F0F0F0F0A0AF0F0F0F00A0A0A0A0A0A0F0F0A0A0A0A0A0AF00A0A0A0A0A0A0A0A0A0A0A0A0A0A0A0AF00A0A0A0A0A0A0F0F0A0A0A0A0A0AF0F0F0F00A0A0F0F0F0F0F0F0A0AF0F0F0F0F0F0F0F00F0F0F0F0F0FF0F0F0F0F0F0F0F0F0F0F0F00F0FF0F0F0F0F0F0F0"},{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00808F0F0F0F0F0F0F0F0F0F0F0F0080808080808F0F0F0F0F0F0F0F008080208020802080808F0F0F0F00808080808020802080808080808F008080808080808080808080808080808F00808080808080808080808080808F0F0F0F008080808020802080208F0F0F0F0F0F0F0F0080808020802F0F0F0F0F0F0F0F0F0F0F0F00808F0F0F0F0F0F0F0"},{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00904F0F0F0F0F0F0F0F0F0F0F0F0040409090404F0F0F0F0F0F0F0F009090904040909090404F0F0F0F00909040909090404090909040909F004040909040409090904040909040409F00904090904040404090904090909F0F0F0F004090909090904090904F0F0F0F0F0F0F0F0040409090404F0F0F0F0F0F0F0F0F0F0F0F00409F0F0F0F0F0F0F0"},{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F00707F0F0F0F0F0F0F0F0F0F0F0F0070707070707F0F0F0F0F0F0F0F007070707070707070707F0F0F0F00707070707070707070707070707F00707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070707070303070707070707070707070707030303030307070707070707070707030303F00303030307070707070703030303F0F0F0F003030303070703030303F0F0F0F0F0F0F0F0030303030303F0F0F0F0F0F0F0F0F0F0F0F00303F0F0F0F0F0F0F0"},{"flags":[],"word":"","label":"","gfx":"F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F00000F0F0F0F0F0F0F0F0F0F0F0F0F0000A0A0000F0F0F0F0F0F0F0F0F0F0000A0A0303030000F0F0F0F0F0F0F0000A0A00000303030300F0F0F0F0F0000A0A030303000003000AF0F0F0F0000A0A000003030303000A0AF0F0F0000A0A030303000003000A0A0AF0F0000A0A000003030303000A0A0A0AF0000A0A030303000003000A0A0A0A0A000A0A000003030303000A0A0A0A0A0A000A030303000003000A0A0A0A0A0A0AF0000003030303000A0A0A0A0A0A0AF0F0F0F0000003000A0A0A0A0A0AF0F0F0F0F0F0F0F0000A0A0A0A0AF0F0F0F0F0F0F0F0F0F0F0F00A0AF0F0F0F0F0F0F0"}],"platform":"iigs","levels":[{"loadword":"","objects":[],"tickword":"","moveword":"","map":"000000000000000000000000000000000000000000000000000000000000000000000000000000000000002000000000200000000000000000000000000000400000000040000000000000000000000000000040000020204000000000000000000000000000004000004000000000000000000000000000000000402020400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"}],"tilesets":{"jaye-tileset":"gfx","neut-tileset":"neut"}} \ No newline at end of file diff --git a/ssc/iigs/u2-debug.fnl b/ssc/iigs/u2-debug.fnl new file mode 100644 index 0000000..76a9642 --- /dev/null +++ b/ssc/iigs/u2-debug.fnl @@ -0,0 +1,85 @@ +(import-macros {:sss ! : compile} :ssc.macros) +(local {: cmd : response} (require :link.udpdebug)) + +(local Ssc (require :ssc)) + +(local ssc (Ssc)) + +(compile ssc + (require ssc.iigs.bootstub) + (require ssc.stdlib) + (require ssc.iigs.uthernet2) + + (global word u2-debug-server-connected 0) + (fn u2-init-debug-server () + (u2-reset) + (u2-udp-server-start 6502) + (set! u2-debug-server-connected 0)) + + (asm u2-debug-buffer (bytes [(string.rep "\x00" 1500)])) + + (fn u2-debug-server-poll ()) ; predefine, will be overwritten. wastes a byte (rts). + + (fn u2-debug-server-cmd-write (msgid) + (let (addr (long-at (ref u2-debug-buffer)) + size (word-at (+ (ref u2-debug-buffer) 4))) + (memcpy (+ (far-ref u2-debug-buffer) 6) addr size) + (u2-tx-begin) + (u2-write msgid) + (u2-write [response.ack]) + (u2-tx-complete 2))) + + (fn u2-debug-server-cmd-read (msgid) + (let (addr (long-at (ref u2-debug-buffer)) + size (word-at (+ (ref u2-debug-buffer) 4))) + (u2-tx-begin) + (u2-write msgid) + (u2-write [response.data]) + (u2-write-farbuf addr size) + (u2-tx-complete (+ size 2)))) + + (fn u2-debug-server-cmd-jmp () (asm (jmp ((u2-debug-buffer))))) + + (global word u2-debug-server-paused 0) + (fn u2-debug-server-cmd-pause (msgid) + (set! u2-debug-server-paused (not u2-debug-server-paused)) + (u2-tx-begin) + (u2-write msgid) + (u2-write [response.ack]) + (u2-write u2-debug-server-paused) + (u2-tx-complete 3) + (while u2-debug-server-paused + (u2-debug-server-poll))) + + (fn u2-debug-server-cmd-ping (msgid) + (u2-tx-begin) + (u2-write msgid) + (u2-write [response.ack]) + (u2-tx-complete 2)) + + (fn u2-debug-server-cmd (msgid cmd) + (if (= cmd [cmd.write]) (u2-debug-server-cmd-write msgid) + (= cmd [cmd.read]) (u2-debug-server-cmd-read msgid) + (= cmd [cmd.jmp]) (u2-debug-server-cmd-jmp) + (= cmd [cmd.pause]) (u2-debug-server-cmd-pause msgid) + (= cmd [cmd.ping]) (u2-debug-server-cmd-ping msgid))) + + (fn u2-debug-server-poll () + (let (size (u2-rx-begin)) + (when (> size 0) + (let (msgid (u2-read) + cmd (u2-read)) + (u2-read-buf (ref u2-debug-buffer) (- size 2)) + (u2-rx-complete) + (when (not u2-debug-server-connected) + (u2-set-tx-dest u2-udp-recv-ip 6502) + (set! u2-debug-server-connected true)) + (u2-debug-server-cmd msgid cmd))))) + + (fn main () + (u2-init-debug-server) + (while true (u2-debug-server-poll))) +) + + +ssc diff --git a/ssc/iigs/uthernet2.fnl b/ssc/iigs/uthernet2.fnl new file mode 100644 index 0000000..c649111 --- /dev/null +++ b/ssc/iigs/uthernet2.fnl @@ -0,0 +1,144 @@ +; uthernet ii driver +(local config { + :gateway [172 24 1 1] + :netmask [255 255 255 0] + :ip [172 24 1 6] + :slot 4 + :mac [0xAD 0xE9 0xA5 0x4A 0x6D 0x66] +}) + +(import-macros {:sss ! : compile} :ssc.macros) + +(fn reg [base] (tostring (+ base (* config.slot 16)))) +(let [U2-MODE (reg 0xc084) + U2-ADDR-HI (reg 0xc085) + U2-ADDR-LO (reg 0xc086) + U2-DATA (reg 0xc087)] + #(compile $1 + (fn u2-addr! (addr) (word! (ref [U2-ADDR-HI]) (byteswap addr))) + (form u2-read [#($1:expr-poly [:byte-at [:ref U2-DATA]])]) + (form u2-write [#($1:expr-poly [:byte! [:ref U2-DATA] $2])]) + (fn u2-read-word () + (let (hi (u2-read) + lo (u2-read)) + (| (byteswap hi) lo))) + (fn u2-write-word (w) + (let (hi (& (byteswap w) 0xff) + lo (& w 0xff)) + (u2-write hi) + (u2-write lo))) + + (fn u2-read-buf (addr count) + (asm (ldx count) + (ldy 0) + (sep 0x20) + loop + (lda [U2-DATA]) + (sta (addr) y) + (iny) + (dex) + (bne loop) + + (rep 0x20))) + + (fn u2-write-buf (addr count) + (asm (ldx count) + (ldy 0) + (sep 0x20) + loop + (lda (addr) y) + (sta [U2-DATA]) + (iny) + (dex) + (bne loop) + + (rep 0x20))) + + (fn u2-write-farbuf ((long addr) count) + (asm (lda addr) (sta [$1.ADDR_LO]) + (lda addr 2) (sta [$1.ADDR_HI]) + (ldx count) + (ldy 0) + (sep 0x20) + loop + (lda (([$1.ADDR_LO])) y) + (sta [U2-DATA]) + (iny) + (dex) + (bne loop) + + (rep 0x20))) + + (asm u2-ipconfig + (bytes [config.gateway]) + (bytes [config.netmask]) + (bytes [config.mac]) + (bytes [config.ip])) + + (fn u2-reset () + (byte! (ref [U2-MODE]) 0x80) + (byte! (ref [U2-MODE]) 0x03) + (u2-addr! 0x0001) + (u2-write-buf (ref u2-ipconfig) 18) + (u2-addr! 0x0016) (u2-write 0)) ; disable interrupts + + (fn u2-udp-server-start (port) + (u2-addr! 0x001a) + (u2-write 0x03) ; allocate all 8kb rx buffer to socket 0 + (u2-write 0x03) ; same, but tx + (u2-addr! 0x0400) + (u2-write 0x42) ; UDP, filter by MAC + (u2-addr! 0x0404) ; set port + (u2-write (& (byteswap port) 0xff)) ; high byte first + (u2-write (& port 0xff)) + (u2-addr! 0x0401) + (u2-write 0x01)) ; open socket + + (fn u2-data-ready () + (u2-addr! 0x0426) + (u2-read-word)) + + (global long u2-udp-recv-ip 0) + (global word u2-udp-recv-port 0) + (global word u2-udp-recv-size 0) + (global word u2-udp-recv-rxrd 0) + (fn u2-read-rxtx-ptr (base) (+ (& (u2-read-word) 0x1fff) base)) + (fn u2-rx-begin () + (if (u2-data-ready) + (do (u2-addr! 0x0428) + (let (rxrd (u2-read-rxtx-ptr 0x4000)) + (set! u2-udp-recv-rxrd rxrd) + (u2-addr! rxrd) + (u2-read-buf (ref u2-udp-recv-ip) 8) + ; convert from network order + (set! u2-udp-recv-port (byteswap u2-udp-recv-port)) + (set! u2-udp-recv-size (byteswap u2-udp-recv-size)) + (- u2-udp-recv-size 8))) + 0)) + + (fn u2-rx-complete () + (u2-addr! 0x0428) + (u2-addr! (+ u2-udp-recv-rxrd u2-udp-recv-size)) + (u2-addr! 0x0401) + (u2-write 0x40)) ; RECV command + + (fn u2-set-tx-dest ((long ip) port) + (u2-addr! 0x040c) + (u2-write-word (byteswap (loword ip))) ; ip is always network order + (u2-write-word (byteswap (hiword ip))) + (u2-write-word port)) + + (fn u2-tx-begin () + (u2-addr! 0x0424) + (let (txwr (u2-read-rxtx-ptr 0x6000)) + (u2-addr! txwr))) + + (fn u2-tx-complete (size) + (u2-addr! 0x0424) + (let (txwr (u2-read-rxtx-ptr 0x6000)) + (u2-addr! 0x0424) + (u2-write-word (+ txwr size)) + (u2-addr! 0x0401) + (u2-write 0x20))) ; SEND command + + )) diff --git a/ssc/init.fnl b/ssc/init.fnl index 43bfa64..1bdfa86 100644 --- a/ssc/init.fnl +++ b/ssc/init.fnl @@ -244,13 +244,14 @@ (self:drop (. bindings (- (length bindings) (* i-half 2) -1))))] (values (lume.concat [:block] compiled-bindings [compiled-body] compiled-cleanup) etype))) :fn (lambda [self name args ...] (tset self.functions name (self:compile-function name args ...))) - :if (lambda [self test iftrue ?iffalse] + :if (lambda [self test iftrue ?else ...] (let [(c-true truetype) (self:expr-poly iftrue) - (c-false falsetype) (when ?iffalse (self:expr-poly ?iffalse)) + iffalse (if (> (select :# ...) 0) [:if ?else ...] ?else) + (c-false falsetype) (when (not= iffalse nil) (self:expr-poly iffalse)) etype (if (not= truetype falsetype) :void truetype) block [:block (self:gen-condition test :-if-true- :-if-false-) :-if-true- c-true] - cl-false (if ?iffalse [[:bra :-if-done-] :-if-false- c-false :-if-done-] - [:-if-false-])] + cl-false (if (not= iffalse nil) [[:bra :-if-done-] :-if-false- c-false :-if-done-] + [:-if-false-])] (values (lume.concat block cl-false) etype))) :when (lambda [self test ...] (self:expr-poly [:if test [:do ...]])) :while (lambda [self test ...] @@ -290,15 +291,24 @@ :and (lambda [self ...] (self:cmp-to-bool :and ...)) :loword (lambda [self long] (let [{: lo : setup} (self:expr-opgen long :long)] - (lume.concat [:block] [(when setup (setup))] (lo :lda)))) + (lume.concat [:block] [(when setup (setup))] [(lo :lda)]))) :hiword (lambda [self long] (let [{: hi : setup} (self:expr-opgen long :long)] - (lume.concat [:block] [(when setup (setup))] (hi :lda)))) + (lume.concat [:block] [(when setup (setup))] [(hi :lda)]))) :ref (lambda [self label] [:lda #(loword ($1:lookup-addr label))]) :far-ref (lambda [self label] (values [:block [:lda #(loword ($1:lookup-addr label))] [:sta self.LONG_LO] [:lda #(hiword ($1:lookup-addr label))] [:sta self.LONG_HI]] :long)) + :byteswap (lambda [self word] [:block (self:expr-word word) [:xba]]) ; TODO: maybe handle a few different addressing modes here? re-use if the value is already on the stack? ; TODO: automatically handle far-ref + :byte! (lambda [self ref value] + (let [(c-addr reftype) (self:expr-poly ref)] + (values (match reftype + :word [:block c-addr [:sta self.ADDR_LO] (self:expr-word value) [:ldy 0] [:sep 0x30] [:sta [self.ADDR_LO] :y] [:rep 0x30]] + :long [:block c-addr [:lda self.LONG_LO] [:sta self.ADDR_LO] [:lda self.LONG_HI] [:sta self.ADDR_HI] + (self:expr-word value) [:sep 0x30] [:sta [[self.ADDR_LO]]] [:rep 0x30]] + _ (error (.. "Unknown reference type " reftype))) + :void))) :word! (lambda [self ref value] (let [(c-addr reftype) (self:expr-poly ref)] (values (match reftype @@ -311,6 +321,13 @@ (self:expr-long value) [:ldy 0] [:lda self.LONG_LO] [:sta [1 :s] :y] [:iny] [:iny] [:lda self.LONG_HI] [:sta [1 :s] :y] (self:drop)]) :long (lambda [self value] (values [:block (self:expr-word value) [:sta self.LONG_LO] [:lda 0] [:sta self.LONG_HI]] :long)) + :byte-at (lambda [self ref] + (local (c-ref etype) (self:expr-poly ref)) + (if (= etype :word) + [:block (self:push nil ref :word) [:ldy 0] [:sep 0x30] [:lda [1 :s] :y] [:rep 0x30] [:and 0xff] (self:drop)] + + (= etype :long) + [:block c-ref [:ldy 0] [:sep 0x30] [:lda [[self.LONG_LO]] :y] [:rep 0x30] [:and 0xff]])) :word-at (lambda [self ref] (local (c-ref etype) (self:expr-poly ref)) (if (= etype :word) diff --git a/ssc/stdlib.fnl b/ssc/stdlib.fnl new file mode 100644 index 0000000..e93f2ad --- /dev/null +++ b/ssc/stdlib.fnl @@ -0,0 +1,17 @@ +(import-macros {:sss ! : compile} :ssc.macros) + +#(compile $1 + (fn memcpy ((long src) (long dst) count) + (let (bank (| (hiword dst) (byteswap (hiword src)))) + (asm (lda bank) + (sta [{:abs #(+ ($1:lookup-addr :inst) 1)}]) + (lda src) (tax) + (lda dst) (tay) + (lda count) + (dec) + (phb) + inst + (mvn 0 0) + (plb)))) + ) +