From c596dd198c36cd4c9e82cfbc93d0dd003fdc4b4c Mon Sep 17 00:00:00 2001 From: tzlil Date: Mon, 26 Feb 2024 18:53:34 +0200 Subject: add I2C --- src/Blinker.hs | 104 ++++++++++++++++++++++++++++++++++++++++ src/I2C.hs | 148 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/Main.hs | 71 --------------------------- 3 files changed, 252 insertions(+), 71 deletions(-) create mode 100644 src/Blinker.hs create mode 100644 src/I2C.hs delete mode 100644 src/Main.hs (limited to 'src') diff --git a/src/Blinker.hs b/src/Blinker.hs new file mode 100644 index 0000000..365012a --- /dev/null +++ b/src/Blinker.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# OPTIONS_GHC -option #-} +module Blinker where + +import Clash.Prelude +import Clash.Annotations.SynthesisAttributes +import Clash.Cores.UART +import Control.Monad.Trans.State.Strict +import I2C (i2cMaster, Message) + + +-- 50 MHz +createDomain vSystem{vName="Input", vPeriod=20_000} + +{-# ANN topEntity + (Synthesize + { t_name = "Blinker" + , t_inputs = [ + PortName "CLK0", + PortName "UART_RX" + ] + , t_output = PortName "UART_TX" + }) #-} +topEntity :: + "CLK" ::: Clock Input + `Annotate` 'StringAttr "chip_pin" "R20" + `Annotate` 'StringAttr + "altera_attribute" "-name IO_STANDARD \"3.3-V LVTTL\"" + -> "RX" ::: Signal Input Bit + `Annotate` 'StringAttr + "chip_pin" "M9" + `Annotate` 'StringAttr + "altera_attribute" "-name IO_STANDARD \"2.5V\"" + -> "KEY0" ::: Signal Input Bit + `Annotate` 'StringAttr + "chip_pin" "P11" + `Annotate` 'StringAttr + "altera_attribute" "-name IO_STANDARD \"1.2V\"" + -> "I2C_SCL" ::: BiSignalIn 'PullUp Input (BitSize Bit) + `Annotate` 'StringAttr + "chip_pin B7" + `Annotate` 'StringAttr + "altera_attribute" "-name IO_STANDARD \"2.5V\"" + -> "I2C_SDA" ::: BiSignalIn 'PullUp Input (BitSize Bit) + `Annotate` 'StringAttr + "chip_pin G11" + `Annotate` 'StringAttr + "altera_attribute" "-name IO_STANDARD \"2.5V\"" + -> (Signal Input Bit + `Annotate` 'StringAttr + "chip_pin" "L9" + `Annotate` 'StringAttr + "altera_attribute" "-name IO_STANDARD \"2.5V\"" + ,"I2C_SCL" ::: BiSignalIn 'PullUp Input (BitSize Bit) + `Annotate` 'StringAttr + "chip_pin B7" + `Annotate` 'StringAttr + "altera_attribute" "-name IO_STANDARD \"2.5V\"" + ,"I2C_SDA" ::: BiSignalIn 'PullUp Input (BitSize Bit) + `Annotate` 'StringAttr + "chip_pin G11" + `Annotate` 'StringAttr + "altera_attribute" "-name IO_STANDARD \"2.5V\"" + ) +topEntity clk rx key0 sclIn sdaIn = (txBit,sclOut,sdaOut) + where + baud = SNat @115200 + uart' = exposeClockResetEnable (uart baud) clk resetGen enableGen + (rxWord, txBit, ackUART) = uart' rx txM + (sclOut, sdaOut, ackI2C) = exposeClockResetEnable (i2cMaster (SNat @20_000) i2cM sclIn sdaIn) clk resetGen enableGen + (txM,i2cM) = exposeClockResetEnable mealyS clk resetGen enableGen cpu Initialization (CPUIn <$> key0 <*> (ackUART,ackI2C) <*> rxWord) + + +data CPUIn = CPUIn { + key0 :: Bit, + ackUART :: Bool, + ackI2C :: Bool, + rx :: Maybe (BitVector 8) +} + +type CPUOut = (Maybe (BitVector 8),Maybe Message) + +data CPUState = Initialization + | TransmittingUART (BitVector 8) + | TransmittingI2C Message + | Listening + deriving (Generic, NFDataX) +cpu :: CPUIn -> State CPUState CPUOut +cpu CPUIn{rx=Just rx} = do + put $ Transmitting rx + return (Nothing, Nothing) + +cpu CPUIn{ackUART=True} = put Listening >> return (Nothing, Nothing) +cpu CPUIn{ackI2C=True} = put Listening >> return (Nothing, Nothing) + +cpu _ = get >>= \case + Initialization -> put Listening >> return (Nothing, Nothing) + TransmittingUART s -> return (Just s, Nothing) + TransmittingI2C s -> return (Nothing, Just s) + Listening -> return (Nothing, Nothing) diff --git a/src/I2C.hs b/src/I2C.hs new file mode 100644 index 0000000..d2b4466 --- /dev/null +++ b/src/I2C.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE StandaloneDeriving, LambdaCase #-} +{-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE PartialTypeSignatures #-} +module I2C (i2cMaster, Message) where + +import Clash.Prelude +-- import RetroClash.Utils +-- import RetroClash.Clock +import Control.Monad.State +import Data.Maybe (isNothing) + +type Message = (BitVector 8, BitVector 8, BitVector 8) + +data MessageState + = Init (BitVector 8, BitVector 8, BitVector 8) Init + | SendAddr (BitVector 8, BitVector 8) (SendBits 8) + | SendSubaddr (BitVector 8) (SendBits 8) + | SendDat (SendBits 8) + | Teardown Teardown + deriving (Show, Generic, BitPack, NFDataX) + +data SendBits n + = SendBit SendTransition (BitVector n) (Index n) + | SendAck SendTransition + deriving (Show, Generic, NFDataX) +deriving instance (KnownNat n, 1 <= n) => BitPack (SendBits n) + +data SendTransition = SDASet | Tick + deriving (Show, Enum, Bounded, Eq, Generic, BitPack, NFDataX) + +data Init = StartInit | SDALow | SCLLow + deriving (Show, Enum, Bounded, Eq, Generic, BitPack, NFDataX) + +data Teardown = StartTeardown | SCLHigh | SDAHigh + deriving (Show, Enum, Bounded, Eq, Generic, BitPack, NFDataX) + +startBit :: (KnownNat n) => BitVector n -> SendBits n +startBit xs = SendBit minBound xs minBound + +succIdx :: (Eq a, Enum a, Bounded a) => a -> Maybe a +succIdx x | x == maxBound = Nothing + | otherwise = Just $ succ x + +succBit :: (KnownNat n) => SendBits n -> Maybe (SendBits n) +succBit (SendBit transition xs i) = Just $ case succIdx transition of + Just transition' -> SendBit transition' xs i + Nothing -> maybe (SendAck minBound) (SendBit minBound (xs `shiftL` 1)) $ succIdx i +succBit (SendAck transition) = SendAck <$> succIdx transition + +shiftOut :: (KnownNat n) => SendBits n -> (Maybe Bit, Maybe Bit) +shiftOut (SendBit transition xs i) = (Just $ boolToBit $ transition == Tick, Just $ msb xs) +shiftOut (SendAck transition) = (Just $ boolToBit $ transition == Tick, Nothing) + +-- We only drive clk (clock stretching not implemented), and we never query +-- peripherals over I2C, so we never actually use sdaIn and sclIn +i2cNext :: Maybe Message -> Bit -> Bit -> Maybe MessageState -> Maybe MessageState +i2cNext newMsg _sdaIn _sclIn = \case + Nothing -> Init <$> newMsg <*> pure StartInit + + Just (Init xss@(xs1, xs2, xs3) ramp) -> Just $ maybe (SendAddr (xs2, xs3) (startBit xs1)) (Init xss) $ succIdx ramp + Just (SendAddr xss@(xs2, xs3) b) -> Just $ maybe (SendSubaddr xs3 (startBit xs2)) (SendAddr xss) $ succBit b + Just (SendSubaddr xss@xs3 b) -> Just $ maybe (SendDat (startBit xs3)) (SendSubaddr xss) $ succBit b + Just (SendDat b) -> Just $ maybe (Teardown StartTeardown) SendDat $ succBit b + + Just (Teardown ramp) -> Teardown <$> succIdx ramp + +i2cOutput :: Maybe MessageState -> (Maybe Bit, Maybe Bit) +i2cOutput = \case + Nothing -> (Just 1, Just 1) + + Just (Init _ StartInit) -> (Just 1, Just 1) + Just (Init _ SDALow) -> (Just 1, Just 0) + Just (Init _ SCLLow) -> (Just 0, Just 0) + + Just (SendAddr _ b) -> shiftOut b + Just (SendSubaddr _ b) -> shiftOut b + Just (SendDat b) -> shiftOut b + + Just (Teardown StartTeardown) -> (Just 0, Just 0) + Just (Teardown SCLHigh) -> (Just 1, Just 0) + Just (Teardown SDAHigh) -> (Just 1, Just 1) + +mealyState + :: (HiddenClockResetEnable dom, NFDataX s) + => (i -> State s o) -> s -> (Signal dom i -> Signal dom o) +mealyState f = mealy step + where + step s x = let (y, s') = runState (f x) s in (s', y) + +mealyStateB + :: (HiddenClockResetEnable dom, NFDataX s, Bundle i, Bundle o) + => (i -> State s o) -> s -> (Unbundled dom i -> Unbundled dom o) +mealyStateB f s0 = unbundle . mealyState f s0 . bundle + +i2cMaster + :: (HiddenClockResetEnable dom, 1 <= i2cRate, KnownNat (DomainPeriod dom), 1 <= DomainPeriod dom) + => SNat i2cRate + -> "DATA" ::: Signal dom (Maybe Message) + -> "SCL_IN" ::: BiSignalIn 'PullUp dom (BitSize Bit) + -> "SDA_IN" ::: BiSignalIn 'PullUp dom (BitSize Bit) + -> ( "SCL_OUT" ::: BiSignalOut 'PullUp dom (BitSize Bit) + , "SDA_OUT" ::: BiSignalOut 'PullUp dom (BitSize Bit) + , "READY" ::: Signal dom Bool + ) +i2cMaster i2cRate@SNat msg sclIn sdaIn = (sclOut, sdaOut, ready) + where + i2cClock = riseRate i2cRate + sclIn' = readFromBiSignal sclIn + sdaIn' = readFromBiSignal sdaIn + + (sclOut', sdaOut', ready) = mealyStateB step Nothing (i2cClock, msg, sclIn', sdaIn') + sclOut = writeToBiSignal sclIn sclOut' + sdaOut = writeToBiSignal sdaIn sdaOut' + + step :: (Bool, Maybe Message, Bit, Bit) -> State (Maybe MessageState) (Maybe Bit, Maybe Bit, Bool) + step (tick, msg, sclIn, sdaIn) = do + s <- get + when tick $ modify $ i2cNext msg sdaIn sclIn + s' <- get + let ready = tick && isNothing s' + (sclOut, sdaOut) = i2cOutput s + return (sclOut, sdaOut, ready) + + +type HzToPeriod (rate :: Nat) = Seconds 1 `Div` rate + +type Seconds (s :: Nat) = Milliseconds (1_000 * s) +type Milliseconds (ms :: Nat) = Microseconds (1_000 * ms) +type Microseconds (us :: Nat) = Nanoseconds (1_000 * us) +type Nanoseconds (ns :: Nat) = Picoseconds (1_000 * ns) +type Picoseconds (ps :: Nat) = ps + +type ClockDivider dom ps = ps `Div` DomainPeriod dom + +risePeriod + :: forall ps dom. (HiddenClockResetEnable dom, _) + => SNat ps + -> Signal dom Bool +risePeriod _ = riseEvery (SNat @(ClockDivider dom ps)) + +riseRate + :: forall rate dom. (HiddenClockResetEnable dom, _) + => SNat rate + -> Signal dom Bool +riseRate _ = risePeriod (SNat @(HzToPeriod rate)) \ No newline at end of file diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 index 43f4746..0000000 --- a/src/Main.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE ImplicitParams #-} -{-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -option #-} -module Main where - -import Clash.Prelude -import Clash.Annotations.SynthesisAttributes -import Clash.Cores.UART -import Data.Char (ord) -import Control.Monad.Trans.State.Strict - --- 50 MHz -createDomain vSystem{vName="Input", vPeriod=20_000} - -{-# ANN topEntity - (Synthesize - { t_name = "Main" - , t_inputs = [ - PortName "CLK0", - PortName "UART_RX" - ] - , t_output = PortName "UART_TX" - }) #-} -topEntity :: - "CLK" ::: Clock Input - `Annotate` 'StringAttr "chip_pin" "R20" - `Annotate` 'StringAttr - "altera_attribute" "-name IO_STANDARD \"3.3-V LVTTL\"" - -> "RX" ::: Signal Input Bit - `Annotate` 'StringAttr - "chip_pin" "M9" - `Annotate` 'StringAttr - "altera_attribute" "-name IO_STANDARD \"2.5V\"" - -> "KEY0" ::: Signal Input Bit - `Annotate` 'StringAttr - "chip_pin" "P11" - `Annotate` 'StringAttr - "altera_attribute" "-name IO_STANDARD \"1.2V\"" - -> Signal Input Bit - `Annotate` 'StringAttr - "chip_pin" "L9" - `Annotate` 'StringAttr - "altera_attribute" "-name IO_STANDARD \"2.5V\"" -topEntity clk rx key0 = txBit - where - baud = SNat @115200 - uart' = exposeClockResetEnable (uart baud) clk resetGen enableGen - (rxWord, txBit, ack) = uart' rx txM - txM = (exposeClockResetEnable mealyS clk resetGen enableGen) cpu Listening (CPUIn <$> key0 <*> ack <*> rxWord) - - -data CPUIn = CPUIn { - key0 :: Bit, - ack :: Bool, - rx :: Maybe (BitVector 8) -} - -data CPUState = Transmitting (BitVector 8) | Listening deriving (Generic, NFDataX) -cpu :: CPUIn -> State CPUState (Maybe (BitVector 8)) -cpu CPUIn{rx=Just rx} = do - put $ Transmitting $ rx - return Nothing - -cpu CPUIn{ack=True} = put Listening >> return Nothing - -cpu CPUIn{ack=False,rx=Nothing} = get >>= \case - Transmitting s -> return $ Just s - Listening -> return Nothing \ No newline at end of file -- cgit 1.4.1