honeylisp/ssc/iigs/u2-debug.fnl

104 lines
3 KiB
Fennel

(import-macros {:sss ! : compile} :ssc.macros)
(local {: cmd : response} (require :link.udpdebug))
; -VEDRIVE
; CAT,S1
; BLOAD UDPDEBUG.SYSTEM, TSYS, A$2000
; CALL-151
; 2000S
(local Ssc (require :ssc))
(local ssc (Ssc))
(compile ssc
(start-symbol boot-8)
(org 0x2000)
(fn boot-8 ()
(asm (clc) (xce) (rep 0x30) ; disable emulation mode, 16-bit index registers
(jsr debug-server-loop)
(sec) (xce))) ; re-enter emulation mode
(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)))
(far-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 debug-server-loop ()
(u2-init-debug-server)
(while true (u2-debug-server-poll)))
)
(let [Prodos (require :asm.prodos)
prg (ssc:assemble)
disk (Prodos "ProDOS_Blank.dsk")]
(disk:update-volume-header {:name "UDP.DEBUG"})
(disk:add-file "UDPDEBUG.SYSTEM" Prodos.file-type.SYS 0x2000 (. (prg:org 0x2000) :block :bytes))
(disk:write "UdpDebug.dsk"))
ssc