(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.toolbox)

  (macro out [#(! (WriteLine (far-ref (pstr [$2]))))])

  (buffer hexbuf (cstr "    "))
  (fn printnum (num)
    (long! (ref hexbuf) (HexIt num))
    (WriteCString (far-ref hexbuf)))

  (require ssc.iigs.uthernet2)

  (fn u2-init-debug-server ()
    (out "Starting server")
    (u2-reset)
    (u2-udp-server-start 6502))

  (buffer u2-debug-buffer 1500)

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

  (global word u2-debug-server-paused false)
  (fn u2-debug-server-cmd-write (msgid)
    (set! u2-debug-server-paused true)
    (let (count (word-at (ref u2-debug-buffer)) index 2)
      (printnum count) (out ": # of blocks to write")
      (while (> count 0)
        (let (addr (long-at (+ (ref u2-debug-buffer) index))
              size (word-at (+ (ref u2-debug-buffer) index 4)))
          (printnum (hiword addr)) (printnum (loword addr)) (printnum size) (out ": writing")
          (memcpy (+ (far-ref u2-debug-buffer) index 6) addr size)
          (set! index (+ index size 6))
          (set! count (- count 1))))
      (u2-tx-begin 2)
      (u2-write msgid)
      (u2-write [response.ack])
      (u2-tx-complete)))

  (fn u2-debug-server-cmd-read (msgid)
    (let (index 6 totalsize 0 count (word-at (ref u2-debug-buffer)))
      (printnum count) (out ": # of blocks to read")
      (while (> count 0)
        (let (size (word-at (+ (ref u2-debug-buffer) index)))
          (set! totalsize (+ totalsize size))
          (set! index (+ index 6))
          (set! count (- count 1))))
      (u2-tx-begin (+ totalsize 2))
      (u2-write msgid)
      (u2-write [response.data])
      (set! count (word-at (ref u2-debug-buffer)))
      (set! index 2)
      (while (> count 0)
        (let (addr (long-at (+ (ref u2-debug-buffer) index))
              size (word-at (+ (ref u2-debug-buffer) index 4)))
          (u2-write-farbuf addr size)
          (set! index (+ index 6))
          (set! count (- count 1))))
      (u2-tx-complete)))

  (fn u2-debug-server-cmd-exec (msgid)
    (let (val (asm (jsr u2-debug-buffer))
          longval (asm-long))
      (u2-tx-begin 8)
      (u2-write msgid)
      (u2-write [response.data])
      (u2-write-word val)
      (u2-write-word (loword longval))
      (u2-write-word (hiword longval))
      (u2-tx-complete)))

  (fn u2-debug-server-cmd-pause (msgid)
    (set! u2-debug-server-paused (word-at (ref u2-debug-buffer)))
    (u2-tx-begin 3)
    (u2-write msgid)
    (u2-write [response.ack])
    (u2-write u2-debug-server-paused)
    (u2-tx-complete)
    (while u2-debug-server-paused
      (u2-debug-server-poll)))

  (fn u2-debug-server-cmd-ping (msgid)
    (u2-tx-begin 2)
    (u2-write msgid)
    (u2-write [response.ack])
    (u2-tx-complete))

  (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.eval])  (u2-debug-server-cmd-exec msgid)
        (= 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
        (let (msgid (u2-read)
              cmd (u2-read))
            (printnum msgid) (printnum cmd) (out ": Got message!")
          (u2-read-buf (ref u2-debug-buffer) (- size 2))
          (u2-rx-complete)
          (u2-set-tx-dest u2-udp-recv-ip u2-udp-recv-port)
          (u2-debug-server-cmd msgid cmd)))))

  (fn debug-server-loop ()
    (TextStartUp)
    (IMStartUp)
    (u2-init-debug-server)
    (forever (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