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

IT WORKS

Browse source
This commit is contained in:
Jeremy Penner 2021-09-28 20:19:13 -04:00
parent 3f295581f5
commit 9ec998e128
5 changed files with 38 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

BIN
UdpDebug.dsk
View file

Binary file not shown.

4
asm/65816.fnl
View file

@ -19,7 +19,7 @@
[:rts nil] [:adc :idx] [:per :rell] [:adc :sr] [:stz :dp] [:adc :dp] [:ror :zp] [:adc :idl] ; 0x60-0x67
[:pla nil] [:adc :imm] [:ror nil] [:rtl nil] [:jmp :ind] [:adc :abs] [:ror :abs] [:adc :abl] ; 0x68-0x6f
[:bvs :rel] [:adc :idy] [:adc :idp] [:adc :isy] [:stz :dpx] [:adc :dpx] [:ror :zpx] [:adc :idly] ; 0x70-0x77
[:sei nil] [:adc :aby] [:ply nil] [:tdc nil] [:jmp :ial] [:adc :abx] [:ror :abx] [:adc :alx] ; 0x78-0x7f
[:sei nil] [:adc :aby] [:ply nil] [:tdc nil] [:jmp :iax] [:adc :abx] [:ror :abx] [:adc :alx] ; 0x78-0x7f
[:bra :rel] [:sta :idx] [:brl :rell] [:sta :sr] [:sty :dp] [:sta :dp] [:stx :dp] [:sta :idl] ; 0x80-0x87
[:dey nil] [:bit :imm] [:txa nil] [:phb nil] [:sty :abs] [:sta :abs] [:stx :abs] [:sta :abl] ; 0x88-0x8f
[:bcc :rel] [:sta :idy] [:sta :idp] [:sta :isy] [:sty :dpx] [:sta :dpx] [:stx :dpy] [:sta :idly] ; 0x90-0x97
@ -31,7 +31,7 @@
[:cpy :imm] [:cmp :idx] [:rep :imm] [:cmp :sr] [:cpy :dp] [:cmp :dp] [:dec :dp] [:cmp :idl] ; 0xc0-0xc7
[:iny nil] [:cmp :imm] [:dex nil] [:wai nil] [:cpy :abs] [:cmp :abs] [:dec :abs] [:cmp :abl] ; 0xc8-0xcf
[:bne :rel] [:cmp :idy] [:cmp :idp] [:cmp :isy] [:pei :idp] [:cmp :dpx] [:dec :dpx] [:cmp :idly] ; 0xd0-0xd7
[:cld nil] [:cmp :aby] [:phx nil] [:stp nil] [:jmp :iax] [:cmp :abx] [:dec :abx] [:cmp :alx] ; 0xd8-0xdf
[:cld nil] [:cmp :aby] [:phx nil] [:stp nil] [:jmp :ial] [:cmp :abx] [:dec :abx] [:cmp :alx] ; 0xd8-0xdf
[:cpx :imm] [:sbc :idx] [:sep :imm] [:sbc :sr] [:cpx :dp] [:sbc :dp] [:inc :dp] [:sbc :idl] ; 0xe0-0xe7
[:inx nil] [:sbc :imm] [:nop nil] [:xba nil] [:cpx :abs] [:sbc :abs] [:inc :abs] [:sbc :abl] ; 0xe8-0xef
[:beq :rel] [:sbc :idy] [:sbc :idp] [:sbc :isy] [:pea :imm] [:sbc :dpx] [:inc :dpx] [:sbc :idly] ; 0xf0-0xf7

20
link/udpdebug.fnl
View file

@ -1,9 +1,9 @@
(local core (require :core))
(local core (require :core))
(local socket (require :socket))
(local {: int16-to-bytes : int32-to-bytes : lo} (require :lib.util))
(local config {
:host "rat.local"
:host "172.24.1.6"
:port 6502
})
@ -43,6 +43,7 @@
(fn [self cmd ?data ?callback]
(let [msgid (self:next-msgid)
msg (.. (string.char msgid cmd) (or ?data ""))]
(print "sending" msgid cmd (length msg))
(when ?callback (tset self.pending msgid ?callback))
(self.connection:send msg)))
:receive
@ -53,7 +54,7 @@
(let [msgid (string.byte (data:sub 1 1))
cmd (string.byte (data:sub 2 2))
pendingfn (. self.pending msgid)]
(print msgid cmd)
(print "recieved" msgid cmd)
(when pendingfn
(tset self.pending msgid nil)
(pendingfn self cmd (data:sub 3))))))))
@ -68,11 +69,12 @@
(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)))
(if (> (length data) 1400) (do (self:write addr (data:sub 1 1400)) (self:write (+ addr 1400) (data:sub 1401)))
(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)))
}

9
ssc/iigs/u2-debug.fnl
View file

@ -23,7 +23,6 @@
(require ssc.stdlib)
(require ssc.iigs.toolbox)
(require ssc.iigs.uthernet2)
(macro out [#(! (WriteLine (far-ref (pstr [$2]))))])
@ -31,7 +30,9 @@
(fn printnum (num)
(long! (ref hexbuf) (HexIt num))
(WriteCString (far-ref hexbuf)))
(require ssc.iigs.uthernet2)
(global word u2-debug-server-connected 0)
(fn u2-init-debug-server ()
(out "Starting server")
@ -89,10 +90,10 @@
(far-fn u2-debug-server-poll ()
(let (size (u2-rx-begin))
(when (> size 0)
(when size
(let (msgid (u2-read)
cmd (u2-read))
(printnum msgid) (out "Got message!")
(printnum msgid) (printnum cmd) (out "Got message!")
(u2-read-buf (ref u2-debug-buffer) (- size 2))
(u2-rx-complete)
(when (not u2-debug-server-connected)

38
ssc/iigs/uthernet2.fnl
View file

@ -15,9 +15,9 @@
U2-ADDR-LO (reg 0xc086)
U2-DATA (reg 0xc087)]
#(compile $1
(form u2-addr! [#($1:expr-poly [:word! [:ref U2-ADDR-HI] [:byteswap $2]])])
(form u2-read [#($1:expr-poly [:byte-at [:ref U2-DATA]])])
(form u2-write [#($1:expr-poly [:byte! [:ref U2-DATA] $2])])
(macro u2-addr! [#[:word! [:ref U2-ADDR-HI] [:byteswap $2]]])
(macro u2-read [#[:byte-at [:ref U2-DATA]]])
(macro u2-write [#[:byte! [:ref U2-DATA] $2]])
(fn u2-read-word ()
(let (hi (u2-read)
lo (u2-read))
@ -89,39 +89,41 @@
(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-write-word port)
(u2-addr! 0x0401)
(u2-write 0x01)) ; open socket
(u2-write 0x01) ; open socket
(u2-addr! 0x0403)
(printnum (u2-read)) (out ": Opened socket"))
(fn u2-data-ready ()
(u2-addr! 0x0426)
(u2-read-word))
(define u2-buf-mask 0x1fff)
(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-complete ()
(u2-addr! 0x0428)
(u2-write-word (+ u2-udp-recv-rxrd 8 u2-udp-recv-size))
(u2-addr! 0x0401)
(u2-write 0x40)) ; RECV command
(fn u2-rxtx-ptr (rd base) (+ (& rd u2-buf-mask) 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)
(set! u2-udp-recv-rxrd (u2-read-word))
(let (rxrd (u2-rxtx-ptr u2-udp-recv-rxrd 0x6000))
(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)))
u2-udp-recv-size))
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
@ -130,12 +132,12 @@
(fn u2-tx-begin ()
(u2-addr! 0x0424)
(let (txwr (u2-read-rxtx-ptr 0x6000))
(let (txwr (u2-rxtx-ptr (u2-read-word) 0x4000))
(u2-addr! txwr)))
(fn u2-tx-complete (size)
(u2-addr! 0x0424)
(let (txwr (u2-read-rxtx-ptr 0x6000))
(let (txwr (u2-rxtx-ptr (u2-read-word) 0x4000))
(u2-addr! 0x0424)
(u2-write-word (+ txwr size))
(u2-addr! 0x0401)