(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