SpindleyQ/honeylisp
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

iigs: untested uthernet-ii debug stub

Browse source 
65816: support 8-bit immediate mode
repl: add re-run and clear buttons
ssc: fix returning false from an else clause
     add byteswap, byte reads / writes
     start stdlib with memcpy
This commit is contained in:
Jeremy Penner 2021-09-23 22:28:48 -04:00
parent c0160c7018
commit ccfb52aeaa
10 changed files with 367 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
asm/65816.fnl
View file

@ -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)

10
asm/asm.fnl
View file

@ -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)

12
editor/replview.fnl
View file

@ -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))))

2
link/init.fnl
View file

@ -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))

77
link/udpdebug.fnl Normal file
View file

@ -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)))
}

2
neutgs/game.json
View file

@ -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"}}
{"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"}}

85
ssc/iigs/u2-debug.fnl Normal file
View file

@ -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

144
ssc/iigs/uthernet2.fnl Normal file
View file

@ -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
))

29
ssc/init.fnl
View file

@ -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)

17
ssc/stdlib.fnl Normal file
View file

@ -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))))
)