honeylisp/ssc/iigs/uthernet2.fnl

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

    (global word u2-udp-send-size 0)
    (fn u2-tx-begin (size)
      (set! u2-udp-send-size size)
      (let (freesize 0) (while (< freesize size)
        (u2-addr! 0x0420) (set! freesize (u2-read-word))))
      (u2-addr! 0x0424)
      (let (txwr (u2-rxtx-ptr (u2-read-word) 0x4000))
        (u2-addr! txwr)))

    (fn u2-tx-complete ()
      (u2-addr! 0x0424)
      (let (txwr (u2-read-word))
        (u2-addr! 0x0424)
        (u2-write-word (+ txwr u2-udp-send-size))
        (u2-addr! 0x0401)
        (u2-write 0x20)))  ; SEND command
  ))