honeylisp/ssc/iigs/u2-debug.fnl

(import-macros {:sss ! : compile} :ssc.macros)
(local {: cmd : response} (require :link.udpdebug))

; sudo route add -net 172.24.1.0/24 gw 192.168.2.25

; -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)]))

  (predef-fn u2-debug-server-poll () void far)

  (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