iigs: untested uthernet-ii debug stub
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:
parent
c0160c7018
commit
ccfb52aeaa
|
@ -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
10
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)
|
||||
|
|
|
@ -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))))
|
||||
|
||||
|
|
|
@ -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
77
link/udpdebug.fnl
Normal 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)))
|
||||
}
|
|
@ -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
85
ssc/iigs/u2-debug.fnl
Normal 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
144
ssc/iigs/uthernet2.fnl
Normal 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
29
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)
|
||||
|
|
17
ssc/stdlib.fnl
Normal file
17
ssc/stdlib.fnl
Normal 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))))
|
||||
)
|
||||
|
Loading…
Reference in a new issue