aboutsummaryrefslogtreecommitdiff
path: root/fpga/src
diff options
context:
space:
mode:
Diffstat (limited to 'fpga/src')
-rw-r--r--fpga/src/App.bs154
-rw-r--r--fpga/src/Top.bs59
-rw-r--r--fpga/src/TopSim.bs32
-rw-r--r--fpga/src/Uart.bs148
-rw-r--r--fpga/src/Util.bs7
-rw-r--r--fpga/src/icebreaker.pcf54
6 files changed, 454 insertions, 0 deletions
diff --git a/fpga/src/App.bs b/fpga/src/App.bs
new file mode 100644
index 0000000..cbe6454
--- /dev/null
+++ b/fpga/src/App.bs
@@ -0,0 +1,154 @@
+package App where
+
+import BRAM
+import GetPut
+
+interface App =
+ led :: Bit 1
+
+hexToBits :: Bit 8 -> Maybe (Bit 4)
+hexToBits 0x30 = Just 0b0000
+hexToBits 0x31 = Just 0b0001
+hexToBits 0x32 = Just 0b0010
+hexToBits 0x33 = Just 0b0011
+hexToBits 0x34 = Just 0b0100
+hexToBits 0x35 = Just 0b0101
+hexToBits 0x36 = Just 0b0110
+hexToBits 0x37 = Just 0b0111
+hexToBits 0x38 = Just 0b1000
+hexToBits 0x39 = Just 0b1001
+hexToBits 0x41 = Just 0b1010
+hexToBits 0x42 = Just 0b1011
+hexToBits 0x43 = Just 0b1100
+hexToBits 0x44 = Just 0b1101
+hexToBits 0x45 = Just 0b1110
+hexToBits 0x46 = Just 0b1111
+hexToBits 0x61 = Just 0b1010
+hexToBits 0x62 = Just 0b1011
+hexToBits 0x63 = Just 0b1100
+hexToBits 0x64 = Just 0b1101
+hexToBits 0x65 = Just 0b1110
+hexToBits 0x66 = Just 0b1111
+hexToBits _ = Nothing
+
+bitsToHex :: Bit 4 -> Bit 8
+bitsToHex b =
+ if b < 10
+ then 0x30 + (0 ++ b)
+ else 0x41 + (0 ++ (b - 10))
+
+data State
+ = WaitingForAddrHiNybble
+ | WaitingForAddrLoNybble (Bit 4)
+ | WaitingForRW (Bit 8)
+ | WaitingForRead
+ | WritingData3 (Bit 12)
+ | WritingData2 (Bit 8)
+ | WritingData1 (Bit 4)
+ | WritingCR
+ | WritingLF
+ | WaitingForValueNybble1 (Bit 8)
+ | WaitingForValueNybble2 (Bit 8) (Bit 4)
+ | WaitingForValueNybble3 (Bit 8) (Bit 8)
+ | WaitingForValueNybble4 (Bit 8) (Bit 12)
+ deriving (Bits)
+
+mkApp :: Get (Bit 8) -> Put (Bit 8) -> Module App
+mkApp uartRecv uartSend =
+ module
+ led :: Reg (Bit 1) <- mkReg 1
+ state :: Reg State <- mkReg WaitingForAddrHiNybble
+ ebr :: BRAM2Port (Bit 8) (Bit 16) <- mkBRAM2Server
+ (defaultValue { memorySize = 256 })
+
+ rules
+ "get_hi_nybble": when WaitingForAddrHiNybble <- state ==> do
+ byte <- uartRecv.get
+ case hexToBits byte of
+ Just hiNybble -> do
+ uartSend.put byte
+ state := WaitingForAddrLoNybble hiNybble
+ Nothing -> return ()
+ "get_lo_nybble": when WaitingForAddrLoNybble hiNybble <- state ==> do
+ byte <- uartRecv.get
+ case hexToBits byte of
+ Just loNybble -> do
+ uartSend.put byte
+ state := WaitingForRW (hiNybble ++ loNybble)
+ led := 0
+ Nothing -> return ()
+ "get_rw": when WaitingForRW addr <- state ==> do
+ byte <- uartRecv.get
+ case byte of
+ 0x72 {- r -} -> do
+ uartSend.put byte
+ ebr.portA.request.put (BRAMRequest
+ { write = False
+ ; responseOnWrite = _
+ ; address = addr
+ ; datain = _
+ })
+ state := WaitingForRead
+ 0x77 {- w -} -> do
+ uartSend.put byte
+ state := WaitingForValueNybble1 addr
+ _ -> return ()
+ "get_read": when WaitingForRead <- state ==> do
+ resp <- ebr.portA.response.get
+ uartSend.put (bitsToHex resp[15:12])
+ state := WritingData3 resp[11:0]
+ "write_data_3": when WritingData3 resp <- state ==> do
+ uartSend.put (bitsToHex resp[11:8])
+ state := WritingData2 resp[7:0]
+ "write_data_2": when WritingData2 resp <- state ==> do
+ uartSend.put (bitsToHex resp[7:4])
+ state := WritingData1 resp[3:0]
+ "write_data_1": when WritingData1 resp <- state ==> do
+ uartSend.put (bitsToHex resp)
+ state := WritingCR
+ "write_cr": when WritingCR <- state ==> do
+ uartSend.put 0x0d
+ state := WritingLF
+ "write_lf": when WritingLF <- state ==> do
+ uartSend.put 0x0a
+ state := WaitingForAddrHiNybble
+ led := 1
+ "get_nybble_1": when WaitingForValueNybble1 addr <- state ==> do
+ byte <- uartRecv.get
+ case hexToBits byte of
+ Just nybble -> do
+ uartSend.put byte
+ state := WaitingForValueNybble2 addr nybble
+ Nothing -> return ()
+ "get_nybble_2": when WaitingForValueNybble2 addr value <- state ==> do
+ byte <- uartRecv.get
+ case hexToBits byte of
+ Just nybble -> do
+ uartSend.put byte
+ state := WaitingForValueNybble3 addr (value ++ nybble)
+ Nothing -> return ()
+ "get_nybble_3": when WaitingForValueNybble3 addr value <- state ==> do
+ byte <- uartRecv.get
+ case hexToBits byte of
+ Just nybble -> do
+ uartSend.put byte
+ state := WaitingForValueNybble4 addr (value ++ nybble)
+ Nothing -> return ()
+ "get_nybble_4": when WaitingForValueNybble4 addr value <- state ==> do
+ byte <- uartRecv.get
+ case hexToBits byte of
+ Just nybble -> do
+ uartSend.put byte
+ ebr.portA.request.put (BRAMRequest
+ { write = True
+ ; responseOnWrite = False
+ ; address = addr
+ ; datain = value ++ nybble
+ })
+ state := WritingCR
+ Nothing -> return ()
+
+ interface App
+ led = led
+
+-- vim: set ft=haskell :
diff --git a/fpga/src/Top.bs b/fpga/src/Top.bs
new file mode 100644
index 0000000..9afaaab
--- /dev/null
+++ b/fpga/src/Top.bs
@@ -0,0 +1,59 @@
+package Top where
+
+import App
+import Uart
+
+interface Top =
+ -- RS232
+ rx :: Bit 1 -> Action {-# always_enabled, always_ready, prefix = "", arg_names = [RX] #-}
+ tx :: Bit 1 {-# always_ready, result = TX #-}
+ -- Onboard LEDs
+ ledR_N :: Bit 1 {-# always_ready, result = LEDR_N #-}
+ ledG_N :: Bit 1 {-# always_ready, result = LEDG_N #-}
+ -- RGB LED driver
+ ledRed_N :: Bit 1 {-# always_ready, result = LED_RED_N #-}
+ ledGrn_N :: Bit 1 {-# always_ready, result = LED_GRN_N #-}
+ ledBlu_N :: Bit 1 {-# always_ready, result = LED_BLU_N #-}
+ -- LEDs and buttons (PMOD 2)
+ led1 :: Bit 1 {-# always_ready, result = LED1 #-}
+ led2 :: Bit 1 {-# always_ready, result = LED2 #-}
+ led3 :: Bit 1 {-# always_ready, result = LED3 #-}
+ led4 :: Bit 1 {-# always_ready, result = LED4 #-}
+ led5 :: Bit 1 {-# always_ready, result = LED5 #-}
+ btn1 :: Bit 1 -> Action {-# always_enabled, always_ready, prefix = "", arg_names = [BTN1] #-}
+ btn2 :: Bit 1 -> Action {-# always_enabled, always_ready, prefix = "", arg_names = [BTN2] #-}
+ btn3 :: Bit 1 -> Action {-# always_enabled, always_ready, prefix = "", arg_names = [BTN3] #-}
+
+clockFreqHz :: Integer
+clockFreqHz = 12_000_000
+
+mkTop :: Module Top
+mkTop =
+ module
+ uart <- mkUart (clockFreqHz / 9600)
+ app <- mkApp uart.recv uart.send
+
+ interface Top
+ -- RS232
+ rx = uart.rxPin
+ tx = uart.txPin
+ -- Onboard LEDs
+ ledR_N = uart.txPin
+ ledG_N = 1 - app.led
+ -- RGB LED driver
+ ledRed_N = 1
+ ledGrn_N = 1
+ ledBlu_N = 1
+ -- LEDs and buttons (PMOD 2)
+ led1 = 0
+ led2 = 0
+ led3 = 0
+ led4 = 0
+ led5 = 0
+ btn1 _ = return ()
+ btn2 _ = return ()
+ btn3 _ = return ()
+{-# verilog mkTop #-}
+{-# properties mkTop = { RSTN = BTN_N } #-}
+
+-- vim: set ft=haskell :
diff --git a/fpga/src/TopSim.bs b/fpga/src/TopSim.bs
new file mode 100644
index 0000000..d0d17cb
--- /dev/null
+++ b/fpga/src/TopSim.bs
@@ -0,0 +1,32 @@
+package TopSim where
+
+import App
+import GetPut
+import Uart
+
+mkTopSim :: Module Empty
+mkTopSim =
+ module
+ timer :: Reg (Bit 8) <- mkReg 0
+
+ uart <- mkUart 1
+ app <- mkApp uart.recv uart.send
+
+ fakeUart <- mkUart 1
+
+ rules
+ when True ==> timer := timer + 1
+ when True ==> uart.rxPin fakeUart.txPin
+ when (timer == 0x00) ==> fakeUart.send.put 0x30
+ when (timer == 0x01) ==> fakeUart.send.put 0x30
+ when (timer == 0x02) ==> fakeUart.send.put 0x77
+ when (timer == 0x03) ==> fakeUart.send.put 0x31
+ when (timer == 0x04) ==> fakeUart.send.put 0x32
+ when (timer == 0x05) ==> fakeUart.send.put 0x33
+ when (timer == 0x06) ==> fakeUart.send.put 0x34
+ when (timer == 0x10) ==> fakeUart.send.put 0x30
+ when (timer == 0x11) ==> fakeUart.send.put 0x30
+ when (timer == 0x12) ==> fakeUart.send.put 0x72
+ when (timer == 0xff) ==> $finish
+
+-- vim: set ft=haskell :
diff --git a/fpga/src/Uart.bs b/fpga/src/Uart.bs
new file mode 100644
index 0000000..1059a65
--- /dev/null
+++ b/fpga/src/Uart.bs
@@ -0,0 +1,148 @@
+package Uart where
+
+import FIFOF
+import GetPut
+import Util
+
+interface Clock =
+ clk :: Bool
+
+mkDivider :: Integer -> Module Clock
+mkDivider divisor =
+ module
+ count :: Reg (Bit 32) <- mkReg 0
+
+ rules
+ "increment_divider": when True ==> do
+ if count == fromInteger (divisor - 1) then do
+ count := 0
+ else
+ count := count + 1
+
+ interface Clock
+ clk = count == 0
+
+-- | The state of the TX side of the UART.
+data TxState
+ = -- | The UART is not currently sending anything. May transition to
+ -- 'Start b' when ready to send 'b'.
+ Idle
+ | -- | The UART is about to send the start bit. 'Start b' transitions to
+ -- 'Data b 7' by sending the start bit.
+ Start (Bit 8)
+ | -- | The UART is about to send a data bit. 'Data b n' transitions to
+ -- 'Data (b >> 1) (n - 1)' by sending a data bit. 'Data b 0' transitions to
+ -- 'Idle' by sending the last data bit. Being in the 'Idle' state for a
+ -- clock transmits the stop bit.
+ Data (Bit 8) (Bit 3)
+ deriving (Bits)
+
+-- | The TX side of the UART.
+interface TxUart =
+ -- | The TX pin.
+ pin :: Bit 1
+ -- | Writes a byte to the UART's transmit buffer.
+ send :: Put (Bit 8)
+
+mkTxUart :: Clock -> Integer -> Module TxUart
+mkTxUart baudClock bufferSize =
+ module
+ fifo :: FIFOF (Bit 8) <- mkSizedFIFOF bufferSize
+ state :: Reg TxState <- mkReg Idle
+ pin :: Reg (Bit 1) <- mkReg 1
+
+ rules
+ "uart_tx": when baudClock.clk
+ rules
+ "uart_tx_idle": when Idle <- state, not fifo.notEmpty ==> do
+ pin := 1
+ "uart_tx_idle_to_start": when Idle <- state, fifo.notEmpty ==> do
+ pin := 1
+ b <- (toGet fifo).get
+ state := Start b
+ "uart_tx_start": when Start b <- state ==> do
+ pin := 0
+ state := Data b 7
+ "uart_tx_data": when Data b n <- state ==> do
+ pin := b[0:0]
+ if n == 0 then
+ state := Idle
+ else
+ state := Data (b >> 1) (n - 1)
+ interface TxUart
+ pin = pin
+ send = toPut fifo
+
+-- | The state of the RX side of the UART.
+data RxState
+ = -- | The initial state of the UART, and the state after receiving the stop
+ -- bit. May transition to 'Data 0 0' when the start bit is received.
+ Idle
+ | -- | In the 'Data _ n' state, the UART has received the start bit and 'n'
+ -- data bits, and is about to receive more data bits. 'Data _ n'
+ -- transitions to 'Data _ (n + 1)' by receiving a data bit. 'Data b 7'
+ -- transitions to 'Stop' by receving the last data bit.
+ Data (Bit 8) (Bit 3)
+ | -- | In the 'Stop' state, the UART has received the start and data bits,
+ -- and is waiting for the stop bit (which is ignored). Transitions to
+ -- 'Idle'.
+ Stop (Bit 8)
+ deriving (Bits, FShow)
+
+-- | The RX side of the UART.
+interface RxUart =
+ -- | The RX pin.
+ pin :: Bit 1 -> Action
+ -- | Reads a byte from the UART's receive buffer.
+ recv :: Get (Bit 8)
+
+mkRxUart :: Clock -> Integer -> Module RxUart
+mkRxUart baudClock bufferSize =
+ module
+ fifo :: FIFOF (Bit 8) <- mkGSizedFIFOF True False bufferSize
+ state :: Reg RxState <- mkReg Idle
+ pin :: Wire (Bit 1) <- mkWire
+
+ rules
+ "uart_rx": when baudClock.clk
+ rules
+ "uart_rx_idle_to_start": when Idle <- state, pin == 0 ==> do
+ state := Data 0 0
+ "uart_rx_data_to_data": when Data bits n <- state, n < 7 ==> do
+ state := Data (pin ++ bits[7:1]) (n + 1)
+ "uart_rx_data_to_stop": when Data bits 7 <- state ==> do
+ state := Stop (pin ++ bits[7:1])
+ "uart_rx_stop_to_idle": when Stop bits <- state, pin == 1 ==> do
+ fifo.enq bits
+ state := Idle
+
+ interface RxUart
+ pin bit = pin := bit
+ recv = toGet fifo
+
+-- | An 8n1 UART.
+interface Uart =
+ -- | The RX pin.
+ rxPin :: Bit 1 -> Action
+ -- | The TX pin.
+ txPin :: Bit 1
+
+ -- | Reads a byte from the UART's receive buffer.
+ recv :: Get (Bit 8)
+ -- | Writes a byte to the UART's transmit buffer.
+ send :: Put (Bit 8)
+
+mkUart :: Integer -> Module Uart
+mkUart baudDivisor =
+ module
+ baudClock <- mkDivider baudDivisor
+ rx <- mkRxUart baudClock 8
+ tx <- mkTxUart baudClock 8
+
+ interface Uart
+ rxPin = rx.pin
+ txPin = tx.pin
+ recv = rx.recv
+ send = tx.send
+
+-- vim: set ft=haskell :
diff --git a/fpga/src/Util.bs b/fpga/src/Util.bs
new file mode 100644
index 0000000..ab3074c
--- /dev/null
+++ b/fpga/src/Util.bs
@@ -0,0 +1,7 @@
+package Util where
+
+when_ :: (Monad m) => Bool -> m () -> m ()
+when_ True x = x
+when_ False _ = return ()
+
+-- vim: set ft=haskell :
diff --git a/fpga/src/icebreaker.pcf b/fpga/src/icebreaker.pcf
new file mode 100644
index 0000000..1164c98
--- /dev/null
+++ b/fpga/src/icebreaker.pcf
@@ -0,0 +1,54 @@
+# 12 MHz clock
+set_io -nowarn CLK 35
+
+# RS232
+set_io -nowarn RX 6
+set_io -nowarn TX 9
+
+# LEDs and Button
+set_io -nowarn BTN_N 10
+set_io -nowarn LEDR_N 11
+set_io -nowarn LEDG_N 37
+
+# RGB LED Driver
+set_io -nowarn LED_RED_N 39
+set_io -nowarn LED_GRN_N 40
+set_io -nowarn LED_BLU_N 41
+
+# SPI Flash
+set_io -nowarn FLASH_SCK 15
+set_io -nowarn FLASH_SSB 16
+set_io -nowarn FLASH_IO0 14
+set_io -nowarn FLASH_IO1 17
+set_io -nowarn FLASH_IO2 12
+set_io -nowarn FLASH_IO3 13
+
+# PMOD 1A
+set_io -nowarn P1A1 4
+set_io -nowarn P1A2 2
+set_io -nowarn P1A3 47
+set_io -nowarn P1A4 45
+set_io -nowarn P1A7 3
+set_io -nowarn P1A8 48
+set_io -nowarn P1A9 46
+set_io -nowarn P1A10 44
+
+# PMOD 1B
+set_io -nowarn P1B1 43
+set_io -nowarn P1B2 38
+set_io -nowarn P1B3 34
+set_io -nowarn P1B4 31
+set_io -nowarn P1B7 42
+set_io -nowarn P1B8 36
+set_io -nowarn P1B9 32
+set_io -nowarn P1B10 28
+
+# LEDs and Buttons (PMOD 2)
+set_io -nowarn LED1 26
+set_io -nowarn LED2 27
+set_io -nowarn LED3 25
+set_io -nowarn LED4 23
+set_io -nowarn LED5 21
+set_io -nowarn BTN1 20
+set_io -nowarn BTN2 19
+set_io -nowarn BTN3 18
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-28 22:30:59 +0000