From fde8f4b6420689a5e4e45700b8618cb014a7bf06 Mon Sep 17 00:00:00 2001 From: tzlil Date: Fri, 22 Mar 2024 15:29:21 +0200 Subject: remove I2C crap and get to work --- src/Blinker.hs | 62 +++++++++--------------- src/I2C.hs | 148 --------------------------------------------------------- 2 files changed, 22 insertions(+), 188 deletions(-) delete mode 100644 src/I2C.hs (limited to 'src') diff --git a/src/Blinker.hs b/src/Blinker.hs index 6242f30..4537fb7 100644 --- a/src/Blinker.hs +++ b/src/Blinker.hs @@ -10,7 +10,6 @@ import Clash.Prelude import Clash.Annotations.SynthesisAttributes import Clash.Cores.UART import Control.Monad.Trans.State.Strict -import I2C (i2cMaster, Message) -- 50 MHz @@ -21,85 +20,68 @@ createDomain vSystem{vName="Input", vPeriod=20_000} { t_name = "Blinker" , t_inputs = [ PortName "CLK0", - PortName "UART_RX" + PortName "UART_RX", + PortName "KEY0", + PortName "I2C_SCL", + PortName "I2C_SDA" ] , t_output = PortName "UART_TX" }) #-} topEntity :: - "CLK" ::: Clock Input + "CLK0" ::: 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" + -> "UART_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 "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 "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 "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" ::: BiSignalOut 'PullUp Input (BitSize Bit) - `Annotate` 'StringAttr - "chip_pin B7" - `Annotate` 'StringAttr - "altera_attribute" "-name IO_STANDARD \"2.5V\"" - ,"I2C_SDA" ::: BiSignalOut 'PullUp Input (BitSize Bit) - `Annotate` 'StringAttr - "chip_pin G11" + -> + "UART_TX" ::: Signal Input Bit + `Annotate` 'StringAttr "chip_pin" "L9" `Annotate` 'StringAttr "altera_attribute" "-name IO_STANDARD \"2.5V\"" - ) -topEntity clk rx key0 sclIn sdaIn = (txBit,sclOut,sdaOut) +topEntity clk rx key0 sclIn sdaIn = (txBit) 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 - f = exposeClockResetEnable mealyS clk resetGen enableGen cpu Initialization (CPUIn <$> key0 <*> ackUART <*> ackI2C <*> rxWord) - (txM,i2cM) = unbundle f + f = exposeClockResetEnable mealyS clk resetGen enableGen cpu Initialization (CPUIn <$> key0 <*> ackUART <*> rxWord) + txM = unbundle f data CPUIn = CPUIn { key0 :: Bit, ackUART :: Bool, - ackI2C :: Bool, rx :: Maybe (BitVector 8) } -type CPUOut = (Maybe (BitVector 8),Maybe Message) +type CPUOut = Maybe (BitVector 8) data CPUState = Initialization | TransmittingUART (BitVector 8) - | TransmittingI2C Message | Listening deriving (Generic, NFDataX) cpu :: CPUIn -> State CPUState CPUOut cpu CPUIn{rx=Just rx} = do put $ TransmittingUART rx - return (Nothing, Nothing) + return Nothing -cpu CPUIn{ackUART=True} = put Listening >> return (Nothing, Nothing) -cpu CPUIn{ackI2C=True} = put Listening >> return (Nothing, Nothing) +cpu CPUIn{ackUART=True} = put Listening >> return 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) + Initialization -> put Listening >> return Nothing + TransmittingUART s -> return $ Just s + Listening -> return Nothing diff --git a/src/I2C.hs b/src/I2C.hs deleted file mode 100644 index d2b4466..0000000 --- a/src/I2C.hs +++ /dev/null @@ -1,148 +0,0 @@ -{-# 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 -- cgit 1.4.1