diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/App.bs | 154 | ||||
| -rw-r--r-- | src/Top.bs | 59 | ||||
| -rw-r--r-- | src/TopSim.bs | 32 | ||||
| -rw-r--r-- | src/Uart.bs | 148 | ||||
| -rw-r--r-- | src/Util.bs | 7 | ||||
| -rw-r--r-- | src/icebreaker.pcf | 54 |
6 files changed, 0 insertions, 454 deletions
diff --git a/src/App.bs b/src/App.bs deleted file mode 100644 index cbe6454..0000000 --- a/src/App.bs +++ /dev/null @@ -1,154 +0,0 @@ -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/src/Top.bs b/src/Top.bs deleted file mode 100644 index 9afaaab..0000000 --- a/src/Top.bs +++ /dev/null @@ -1,59 +0,0 @@ -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/src/TopSim.bs b/src/TopSim.bs deleted file mode 100644 index d0d17cb..0000000 --- a/src/TopSim.bs +++ /dev/null @@ -1,32 +0,0 @@ -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/src/Uart.bs b/src/Uart.bs deleted file mode 100644 index 1059a65..0000000 --- a/src/Uart.bs +++ /dev/null @@ -1,148 +0,0 @@ -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/src/Util.bs b/src/Util.bs deleted file mode 100644 index ab3074c..0000000 --- a/src/Util.bs +++ /dev/null @@ -1,7 +0,0 @@ -package Util where - -when_ :: (Monad m) => Bool -> m () -> m () -when_ True x = x -when_ False _ = return () - --- vim: set ft=haskell : diff --git a/src/icebreaker.pcf b/src/icebreaker.pcf deleted file mode 100644 index 1164c98..0000000 --- a/src/icebreaker.pcf +++ /dev/null @@ -1,54 +0,0 @@ -# 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 |