honeylisp/ssc/iigs/uthernet2.fnl
2021-09-28 20:19:13 -04:00

147 lines
3.9 KiB
Fennel

; uthernet ii driver
(local config {
:gateway [172 24 1 1]
:netmask [255 255 255 0]
:ip [172 24 1 6]
:slot 3
:mac [0xAD 0xE9 0xA5 0x4A 0x6D 0x66]
})
(import-macros {:sss ! : compile} :ssc.macros)
(fn reg [base] (tostring (+ base (* config.slot 16))))
(let [U2-MODE (reg 0xc084)
U2-ADDR-HI (reg 0xc085)
U2-ADDR-LO (reg 0xc086)
U2-DATA (reg 0xc087)]
#(compile $1
(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))
(| (byteswap hi) lo)))
(fn u2-write-word (w)
(let (hi (& (byteswap w) 0xff)
lo (& w 0xff))
(u2-write hi)
(u2-write lo)))
(fn u2-read-buf (addr count)
(asm (lda count) (tax)
(ldy 0)
(sep 0x20)
loop
(lda [U2-DATA])
(sta (addr) y)
(iny)
(dex)
(bne loop)
(rep 0x20)))
(fn u2-write-buf (addr count)
(asm (lda count) (tax)
(ldy 0)
(sep 0x20)
loop
(lda (addr) y)
(sta [U2-DATA])
(iny)
(dex)
(bne loop)
(rep 0x20)))
(fn u2-write-farbuf ((long addr) count)
(asm (lda addr) (sta [$1.ADDR_LO])
(lda addr 2) (sta [$1.ADDR_HI])
(lda count) (tax)
(ldy 0)
(sep 0x20)
loop
(lda (([$1.ADDR_LO])) y)
(sta [U2-DATA])
(iny)
(dex)
(bne loop)
(rep 0x20)))
(asm u2-ipconfig
(bytes [config.gateway])
(bytes [config.netmask])
(bytes [config.mac])
(bytes [config.ip]))
(fn u2-reset ()
(byte! (ref [U2-MODE]) 0x80)
(byte! (ref [U2-MODE]) 0x03)
(u2-addr! 0x0001)
(u2-write-buf (ref u2-ipconfig) 18)
(u2-addr! 0x0016) (u2-write 0)) ; disable interrupts
(fn u2-udp-server-start (port)
(u2-addr! 0x001a)
(u2-write 0x03) ; allocate all 8kb rx buffer to socket 0
(u2-write 0x03) ; same, but tx
(u2-addr! 0x0400)
(u2-write 0x42) ; UDP, filter by MAC
(u2-addr! 0x0404) ; set port
(u2-write-word port)
(u2-addr! 0x0401)
(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-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)
(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))
0))
(fn u2-set-tx-dest ((long ip) port)
(u2-addr! 0x040c)
(u2-write-word (byteswap (loword ip))) ; ip is always network order
(u2-write-word (byteswap (hiword ip)))
(u2-write-word port))
(fn u2-tx-begin ()
(u2-addr! 0x0424)
(let (txwr (u2-rxtx-ptr (u2-read-word) 0x4000))
(u2-addr! txwr)))
(fn u2-tx-complete (size)
(u2-addr! 0x0424)
(let (txwr (u2-rxtx-ptr (u2-read-word) 0x4000))
(u2-addr! 0x0424)
(u2-write-word (+ txwr size))
(u2-addr! 0x0401)
(u2-write 0x20))) ; SEND command
))