1 files changed, 125 insertions, 0 deletions
diff --git a/src/Uart.bs b/src/Uart.bs
new file mode 100644
index 0000000..0a3e82b
--- /dev/null
+++ b/src/Uart.bs
@@ -0,0 +1,125 @@
+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
+
+-- | A shift register.
+interface ShiftRegister item numItems =
+  -- | Shifts an item into the shift register.
+  put :: Put item
+  -- | Shifts an item out of the shift register.
+  get :: Get item
+  -- | The number of items currently in the shift register.
+  size :: Bit (TLog numItems)
+
+-- | Creates a shift register.
+mkShiftRegister :: (Bits item itemSize) => Module (ShiftRegister item numItems)
+mkShiftRegister =
+  module
+    size :: Reg (Bit (TLog numItems)) <- mkReg 0
+    buffer :: Reg (Bit (TMul itemSize numItems)) <- mkReg 0
+
+    interface ShiftRegister
+      put = interface Put
+              put _ = return ()
+      get = interface Get
+              get = return (unpack 0) when False
+      size = size
+
+-- | 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
+    -- 'Stop' by sending the last data bit.
+    Data (Bit 8) (Bit 3)
+  | -- | The UART is about to send the stop bit. Transitions to 'Idle'.
+    Stop
+  deriving (Bits)
+
+-- | The TX side of the UART.
+interface TxUart =
+  -- | The TX pin.
+  pin :: Bit 1
+  -- Writes a byte to the UART.
+  send :: Put (Bit 8)
+
+mkTxUart :: Clock -> Integer -> Module TxUart
+mkTxUart baudClock bufferSize =
+  module
+    fifo :: FIFOF (Bit 8) <- mkSizedFIFOF bufferSize
+    state <- mkReg Idle
+    rules
+      "uart_tx_send": when baudClock.clk ==> do
+        case state of
+          Idle -> do
+            b <- (toGet fifo).get
+            state := Start b
+          Start b -> do
+            state := Data b 7
+          Data _ 0 -> do
+            state := Stop
+          Data b n -> do
+            state := Data (b >> 1) (n - 1)
+          Stop -> do
+            state := Idle
+    interface TxUart
+      pin = case state of
+              Idle -> 1
+              Start _ -> 0
+              Data b _ -> b[0:0]
+              Stop -> 1
+      send = toPut 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.
+  recv :: Get (Bit 8)
+  -- Writes a byte to the UART.
+  send :: Put (Bit 8)
+
+mkUart :: Integer -> Module Uart
+mkUart baudDivisor =
+  module
+    baudClock <- mkDivider baudDivisor
+    tx <- mkTxUart baudClock 1
+
+    interface Uart
+      rxPin _bit = when_ baudClock.clk $ do
+        return () -- TODO
+      txPin = tx.pin
+
+      recv = interface Get
+               get = return 0 when False
+      send = tx.send
+
+-- vim: set ft=haskell :