Merge branch 'main' of https://github.com/standardsemiconductor/bayeux …

…into cpu

bayeux.cabal

@@ -69,6 +69,7 @@ test-suite test
     other-modules:    Test.Bayeux.Ice40
                     , Test.Bayeux.Ice40.Led
                     , Test.Bayeux.Ice40.Rgb
+                    , Test.Bayeux.Ice40.Spram
                     , Test.Bayeux.Lp
                     , Test.Bayeux.Rtl
                     , Test.Bayeux.Signal

exe/Main.hs

@@ -37,7 +37,11 @@ parseDemo = asum
   , flag' Hello $ long "Hello" <> help "Hello demo"
   , flag' Echo $ long "Echo" <> help "Echo demo"
   , flag' LedCtrl $ long "LedCtrl" <> help "Control Led IP through UART"
-  , flag' BufEcho $ long "BufEcho" <> help "BufEcho demo"
+  , flag' SpramReverse $ mconcat
+    [ long "SpramReverse"
+    , help "SpramReverse demo: Send bytes to UART, buffer them in SPRAM, then \
+           \read the bytes LIFO."
+    ]
   , flag' Soc $ long "Soc" <> help "Soc demo"
   ]
 

lib/Bayeux.hs

@@ -45,14 +45,14 @@ app = \case
 
 getDemo :: Demo -> File
 getDemo = \case
-  FiatLux    -> fiatLux
-  RgbCounter -> rgbCounter
-  RgbCycle   -> rgbCycle
-  Hello      -> handleErr $ compile hello
-  Echo       -> handleErr $ compile echo
-  LedCtrl    -> handleErr $ compile ledCtrl
-  BufEcho    -> handleErr $ compile bufEcho
-  Soc        -> handleErr $ compile Cpu.soc
+  FiatLux      -> fiatLux
+  RgbCounter   -> rgbCounter
+  RgbCycle     -> rgbCycle
+  Hello        -> handleErr $ compile hello
+  Echo         -> handleErr $ compile echo
+  LedCtrl      -> handleErr $ compile ledCtrl
+  SpramReverse -> handleErr $ compile spramReverse
+  Soc          -> handleErr $ compile Cpu.soc
 
 rgbCounter :: File
 rgbCounter = handleErr $ compile prog

lib/Bayeux/Cell.hs

@@ -4,25 +4,41 @@
 module Bayeux.Cell
   ( -- * Unary
     inc
+  , dec
   , logicNot
   , not
   , -- * Binary
-    add
-  , and
+    and
+  , or
+  , xor
+  , xnor
+  , -- ** Shift
+    shl
+  , shr, sshr
+  , -- ** Logical
+    logicAnd
+  , (.&&)
+  , logicOr
+  , (.||)
+  , -- ** Compare
+    eqx
+  , nex
   , lt
   , le
   , eq
   , (===)
   , ne
   , ge
   , gt
-  , logicAnd
-  , (.&&)
-  , logicOr
-  , (.||)
-  , or
-  , -- ** Shift
-    shr
+  , -- ** Numeric
+    add
+  , sub
+  , mul
+  , div
+  , mod
+  , divFloor
+  , modFloor
+  , pow
   , -- * Control
     ifs, thens, elses
   , ifm, thenm, elsem
@@ -33,30 +49,65 @@ module Bayeux.Cell
   ) where
 
 import Bayeux.Encode
-import Bayeux.Rtl hiding (at, binary, mux, shift, shr, unary)
+import Bayeux.Rtl hiding (at, binary, mux, shift, shr, sshr, shl, unary)
 import Bayeux.Signal
 import Bayeux.Width
 import Control.Monad
 import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
 import Data.Maybe
-import Prelude hiding (and, not, or)
+import Prelude hiding (and, div, mod, not, or)
 
 -- | increment
 inc :: Encode a => Width a => MonadSignal m => Sig a -> m (Sig a)
 inc a = binary addC a $ sig True
 
+dec :: Encode a => Width a => MonadSignal m => Sig a -> m (Sig a)
+dec a = binary subC a $ sig True
+
 logicNot :: MonadSignal m => Sig Bool -> m (Sig Bool)
 logicNot = unary logicNotC
 
 not :: Width a => MonadSignal m => Sig a -> m (Sig a)
 not = unary notC
 
-add :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig a)
-add = binary addC
-
 and :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig a)
 and = binary andC
 
+or :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig a)
+or = binary orC
+
+xor :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig a)
+xor = binary xorC
+
+xnor :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig a)
+xnor = binary xnorC
+
+logicAnd :: MonadSignal m => Sig Bool -> Sig Bool -> m (Sig Bool)
+logicAnd = binary logicAndC
+
+infixr 3 .&&
+(.&&) :: Monad m => MonadSignal m => m (Sig Bool) -> m (Sig Bool) -> m (Sig Bool)
+(.&&) = liftBin logicAnd
+
+logicOr :: MonadSignal m => Sig Bool -> Sig Bool -> m (Sig Bool)
+logicOr = binary logicOrC
+
+infixr 2 .||
+(.||) :: Monad m => MonadSignal m => m (Sig Bool) -> m (Sig Bool) -> m (Sig Bool)
+(.||) = liftBin logicOr
+
+eqx :: Width a => Monad m => MonadSignal m => Sig a -> Sig a -> m (Sig Bool)
+eqx a = flip at 0 <=< eqx' a
+  where
+    eqx' :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig Bool)
+    eqx' = binary eqxC
+
+nex :: Width a => Monad m => MonadSignal m => Sig a -> Sig a -> m (Sig Bool)
+nex a = flip at 0 <=< nex' a
+  where
+    nex' :: Width a => Monad m => MonadSignal m => Sig a -> Sig a -> m (Sig Bool)
+    nex' = binary nexC
+
 lt :: Width a => Monad m => MonadSignal m => Sig a -> Sig a -> m (Sig Bool)
 lt a = flip at 0 <=< lt' a
   where
@@ -103,25 +154,38 @@ liftBin f x y = do
   y' <- y
   f x' y'
 
-logicAnd :: MonadSignal m => Sig Bool -> Sig Bool -> m (Sig Bool)
-logicAnd = binary logicAndC
+shr :: Width a => Width b => MonadSignal m => Sig a -> Sig b -> m (Sig a)
+shr = shift shrC
 
-infixr 3 .&&
-(.&&) :: Monad m => MonadSignal m => m (Sig Bool) -> m (Sig Bool) -> m (Sig Bool)
-(.&&) = liftBin logicAnd
+sshr :: Width a => Width b => MonadSignal m => Sig a -> Sig b -> m (Sig a)
+sshr = shift sshrC
 
-logicOr :: MonadSignal m => Sig Bool -> Sig Bool -> m (Sig Bool)
-logicOr = binary logicOrC
+shl :: Width a => Width b => MonadSignal m => Sig a -> Sig b -> m (Sig a)
+shl = shift shlC
 
-infixr 2 .||
-(.||) :: Monad m => MonadSignal m => m (Sig Bool) -> m (Sig Bool) -> m (Sig Bool)
-(.||) = liftBin logicOr
+add :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig a)
+add = binary addC
 
-or :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig a)
-or = binary orC
+sub :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig a)
+sub = binary subC
 
-shr :: Width a => Width b => MonadSignal m => Sig a -> Sig b -> m (Sig a)
-shr = shift shrC
+mul :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig a)
+mul = binary mulC
+
+div :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig a)
+div = binary divC
+
+mod :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig a)
+mod = binary modC
+
+divFloor :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig a)
+divFloor = binary divFloorC
+
+modFloor :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig a)
+modFloor = binary modFloorC
+
+pow :: Width a => MonadSignal m => Sig a -> Sig a -> m (Sig a)
+pow = binary powC
 
 data Cond a = Cond
   { condition :: Maybe (Sig Bool)

lib/Bayeux/Cli.hs

@@ -23,7 +23,7 @@ data Demo = FiatLux
           | Hello
           | Echo
           | LedCtrl
-          | BufEcho
+          | SpramReverse
           | Soc
   deriving (Eq, Read, Show)
 

lib/Bayeux/Cpu.hs

@@ -62,7 +62,7 @@ cpu instrM = ifm
 justSig :: Sig a -> Sig (Maybe a)
 justSig s = Sig $ (spec . sig) True <> spec s
 
-soc :: Monad m => MonadBuffer m => MonadSignal m => MonadUart m => m ()
+soc :: Monad m => MonadBuffer m => MonadSignal m => MonadUart m => m (Sig Bool)
 soc = transmit 624 =<< cpu =<< fmap cast . buffer =<< receive 624 =<< input "\\rx"
   where 
     cast :: Sig (Maybe (Array (Finite 2) Word8)) -> Sig (Maybe Instr)

lib/Bayeux/Ice40/Spram.hs

@@ -1,10 +1,29 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
+{-# LANGUAGE OverloadedStrings          #-}
 
 module Bayeux.Ice40.Spram
   ( spramC
+  , Word14(..)
+  , Word4(..)
+  , MonadSpram(..)
+  , Req(..)
+  , rSig
+  , wSig
+  , memory
   ) where
 
-import Bayeux.Rtl
+import Bayeux.Cell
+import Bayeux.Encode
+import Bayeux.Rtl hiding (process)
+import Bayeux.Signal
+import Bayeux.Width
+import Control.Monad.Writer
+import Data.Array
+import Data.Finite
+import Data.String
+import Data.Word
 
 spramC
   :: CellId
@@ -34,3 +53,89 @@ spramC name a din maskWrEn wren cs clk sb slp pwrOff dout = Cell
   , CellConnect "\\DATAOUT" dout
   ]
   CellEndStmt
+
+newtype Word14 = Word14{ unWord14 :: Array (Finite 14) Bool }
+  deriving (Encode, Eq, Read, Show, Width)
+
+newtype Word4 = Word4{ unWord4 :: Array (Finite 4) Bool }
+  deriving (Encode, Eq, Read, Show, Width)
+
+class MonadSpram m where
+  spram :: Sig Word14     -- ^ address
+        -> Sig Word16     -- ^ data in
+        -> Sig Word4      -- ^ mask write enable
+        -> Sig Bool       -- ^ write enable
+        -> Sig Bool       -- ^ chip select
+        -> Sig Bool       -- ^ stand by
+        -> Sig Bool       -- ^ sleep
+        -> Sig Bool       -- ^ poweroff
+        -> m (Sig Word16) -- ^ data out
+
+instance MonadSpram Rtl where
+  spram a din maskWrEn wren cs sb slp pwrOff = do
+    i    <- fresh
+    dout <- freshWire 16
+    tell [ModuleBodyCell $ spramC
+      (fromString $ "\\SB_SPRAM256KA_INST" <> show i)
+      (spec a)
+      (spec din)
+      (spec maskWrEn)
+      (spec wren)
+      (spec cs)
+      (SigSpecWireId "\\clk")
+      (spec sb)
+      (spec slp)
+      (spec pwrOff)
+      dout]
+    return $ Sig dout
+
+data Req = R Word14
+         | W Word14 Word16 Word4
+  deriving (Eq, Read, Show)
+
+instance Width Req where
+  width _ = 35
+
+instance Encode Req where
+  encode = \case
+    R a     -> [B0] <> encode a <> replicate 20 B0
+    W a d m -> [B1] <> encode a <> encode d <> encode m
+
+sliceWrEn :: Sig Req -> Sig Bool
+sliceWrEn = slice 34 34
+
+sliceAddr :: Sig Req -> Sig Word14
+sliceAddr = slice 33 20
+
+sliceDataIn :: Sig Req -> Sig Word16
+sliceDataIn = slice 19 4
+
+sliceMaskWrEn :: Sig Req -> Sig Word4
+sliceMaskWrEn = slice 3 0
+
+rSig :: Sig Word14 -> Sig Req
+rSig a = Sig $ (spec . sig) False <> spec a <> fromString ("20'" <> replicate 20 '0')
+
+wSig :: Sig Word14 -> Sig Word16 -> Sig Word4 -> Sig Req
+wSig a d m = Sig $ (spec . sig) True <> spec a <> spec d <> spec m
+
+memory
+  :: Monad       m
+  => MonadSignal m
+  => MonadSpram  m
+  => Sig (Maybe Req)
+  -> m (Sig (Maybe Word16))
+memory reqM = do
+  let req  = sliceValue reqM
+      wrEn = sliceWrEn req
+  b16 <- spram
+    (sliceAddr     req)
+    (sliceDataIn   req)
+    (sliceMaskWrEn req)
+    wrEn
+    (sliceValid reqM)
+    (sig False)
+    (sig False)
+    (sig True)
+  isValid <- process $ const $ logicAnd (sliceValid reqM) =<< logicNot wrEn
+  return $ Sig $ spec isValid <> spec b16

lib/Bayeux/Signal.hs

@@ -10,6 +10,7 @@ module Bayeux.Signal
   , fromMaybeSig
   , sliceValid
   , sliceValue
+  , mapMaybeSig
   , sliceFst
   , sliceSnd
   , MonadSignal(..)
@@ -56,6 +57,9 @@ sliceValid = fst . fromMaybeSig
 sliceValue :: Width a => Sig (Maybe a) -> Sig a
 sliceValue = snd . fromMaybeSig
 
+mapMaybeSig :: Width a => (Sig a -> Sig b) -> Sig (Maybe a) -> Sig (Maybe b)
+mapMaybeSig f a = Sig $ (spec . sliceValid) a <> (spec . f . sliceValue) a
+
 sliceFst :: forall a b. Width a => Width b => Sig (a, b) -> Sig a
 sliceFst s = slice (width s - 1) (width (undefined :: b)) s