diff --git a/changelog/2022-05-12T09_43_48+02_00_trueDualPortBlockRam_initial_contents b/changelog/2022-05-12T09_43_48+02_00_trueDualPortBlockRam_initial_contents new file mode 100644 index 0000000000..9387c3fce2 --- /dev/null +++ b/changelog/2022-05-12T09_43_48+02_00_trueDualPortBlockRam_initial_contents @@ -0,0 +1,5 @@ +CHANGED: the `trueDualPortBlockRam` function now accepts a vector containing the +initial block-RAM contents. +ADDED: the function `trueDualPortBlockRamU` function was added which which +initialises all RAM content to an undefined value. This is the same behaviour as +the `trueDualPortBlockRam` function had before this change. diff --git a/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam.primitives.yaml b/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam.primitives.yaml index b4dc597f05..bfa67abb30 100644 --- a/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam.primitives.yaml +++ b/clash-lib/prims/systemverilog/Clash_Explicit_BlockRam.primitives.yaml @@ -144,6 +144,69 @@ , NFDataX a ~ARG[4] ) => + Vec nAddrs a -> ~ARG[5] + + Clock domA -> ~ARG[6] + Signal domA Bool -> ~ARG[7] + Signal domA Bool -> ~ARG[8] + Signal domA (Index nAddrs) -> ~ARG[9] + Signal domA a -> ~ARG[10] + + Clock domB -> ~ARG[11] + Signal domB Bool -> ~ARG[12] + Signal domB Bool -> ~ARG[13] + Signal domB (Index nAddrs) -> ~ARG[14] + Signal domB a -> ~ARG[15] + (Signal domA a, Signal domB a) + template: |- + // trueDualPortBlockRam begin + // Shared memory + logic [~SIZE[~TYP[10]]-1:0] ~GENSYM[mem][0] [~LIT[1]-1:0]; + + ~SIGD[~GENSYM[data_slow][1]][10]; + ~SIGD[~GENSYM[data_fast][2]][15]; + + initial begin + ~SYM[0] = ~CONST[5]; + end + + // Port A + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[6]) begin + if(~ARG[6]) begin + ~SYM[1] <= ~SYM[0][~IF~SIZE[~TYP[9]]~THEN~ARG[9]~ELSE0~FI]; + if(~ARG[8]) begin + ~SYM[1] <= ~ARG[10]; + ~SYM[0][~IF~SIZE[~TYP[9]]~THEN~ARG[9]~ELSE0~FI] <= ~ARG[10]; + end + end + end + + // Port B + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[11]) begin + if(~ARG[12]) begin + ~SYM[2] <= ~SYM[0][~IF~SIZE[~TYP[14]]~THEN~ARG[14]~ELSE0~FI]; + if(~ARG[13]) begin + ~SYM[2] <= ~ARG[15]; + ~SYM[0][~IF~SIZE[~TYP[14]]~THEN~ARG[14]~ELSE0~FI] <= ~ARG[15]; + end + end + end + + assign ~RESULT = {~SYM[1], ~SYM[2]}; + // end trueDualPortBlockRam +- BlackBox: + name: Clash.Explicit.BlockRam.trueDualPortBlockRamU# + kind: Declaration + type: |- + trueDualPortBlockRamU# :: + forall nAddrs domA domB a . + ( HasCallStack ~ARG[0] + , KnownNat nAddrs ~ARG[1] + , KnownDomain domA ~ARG[2] + , KnownDomain domB ~ARG[3] + , NFDataX a ~ARG[4] + ) => + Clock domA -> ~ARG[5] Signal domA Bool -> ~ARG[6] Signal domA Bool -> ~ARG[7] @@ -157,7 +220,7 @@ Signal domB a -> ~ARG[14] (Signal domA a, Signal domB a) template: |- - // trueDualPortBlockRam begin + // trueDualPortBlockRamU begin // Shared memory logic [~SIZE[~TYP[9]]-1:0] ~GENSYM[mem][0] [~LIT[1]-1:0]; @@ -187,4 +250,4 @@ end assign ~RESULT = {~SYM[1], ~SYM[2]}; - // end trueDualPortBlockRam + // end trueDualPortBlockRamU diff --git a/clash-lib/prims/verilog/Clash_Explicit_BlockRam.primitives.yaml b/clash-lib/prims/verilog/Clash_Explicit_BlockRam.primitives.yaml index 0b73fe3cc2..3506640011 100644 --- a/clash-lib/prims/verilog/Clash_Explicit_BlockRam.primitives.yaml +++ b/clash-lib/prims/verilog/Clash_Explicit_BlockRam.primitives.yaml @@ -155,6 +155,75 @@ , NFDataX a ~ARG[4] ) => + Vec nAddrs a -> ~ARG[5] + + Clock domA -> ~ARG[6] + Signal domA Bool -> ~ARG[7] + Signal domA Bool -> ~ARG[8] + Signal domA (Index nAddrs) -> ~ARG[9] + Signal domA a -> ~ARG[10] + + Clock domB -> ~ARG[11] + Signal domB Bool -> ~ARG[12] + Signal domB Bool -> ~ARG[13] + Signal domB (Index nAddrs) -> ~ARG[14] + Signal domB a -> ~ARG[15] + (Signal domA a, Signal domB a) + template: |- + // trueDualPortBlockRam begin + // Shared memory + reg [~SIZE[~TYP[10]]-1:0] ~GENSYM[mem][0] [~LIT[1]-1:0]; + + reg ~SIGD[~GENSYM[data_slow][1]][10]; + reg ~SIGD[~GENSYM[data_fast][2]][15]; + + reg ~TYP[5] ~GENSYM[ram_init][3]; + integer ~GENSYM[i][4]; + initial begin + ~SYM[3] = ~CONST[5]; + for (~SYM[4]=0; ~SYM[4] < ~LENGTH[~TYP[5]]; ~SYM[4] = ~SYM[4] + 1) begin + ~SYM[1][~LENGTH[~TYP[5]]-1-~SYM[4]] = ~SYM[3][~SYM[4]*~SIZE[~TYP[10]]+:~SIZE[~TYP[10]]]; + end + end + + // Port A + always @(~IF~ACTIVEEDGE[Rising][2]~THENposedge~ELSEnegedge~FI ~ARG[6]) begin + if(~ARG[7]) begin + ~SYM[1] <= ~SYM[0][~IF~SIZE[~TYP[9]]~THEN~ARG[9]~ELSE0~FI]; + if(~ARG[8]) begin + ~SYM[1] <= ~ARG[10]; + ~SYM[0][~IF~SIZE[~TYP[9]]~THEN~ARG[9]~ELSE0~FI] <= ~ARG[10]; + end + end + end + + // Port B + always @(~IF~ACTIVEEDGE[Rising][3]~THENposedge~ELSEnegedge~FI ~ARG[11]) begin + if(~ARG[12]) begin + ~SYM[2] <= ~SYM[0][~IF~SIZE[~TYP[14]]~THEN~ARG[14]~ELSE0~FI]; + if(~ARG[13]) begin + ~SYM[2] <= ~ARG[15]; + ~SYM[0][~IF~SIZE[~TYP[14]]~THEN~ARG[14]~ELSE0~FI] <= ~ARG[15]; + end + end + end + + assign ~RESULT = {~SYM[1], ~SYM[2]}; + + // end trueDualPortBlockRam +- BlackBox: + name: Clash.Explicit.BlockRam.trueDualPortBlockRamU# + kind: Declaration + type: |- + trueDualPortBlockRamU# :: + forall nAddrs domA domB a . + ( HasCallStack ~ARG[0] + , KnownNat nAddrs ~ARG[1] + , KnownDomain domA ~ARG[2] + , KnownDomain domB ~ARG[3] + , NFDataX a ~ARG[4] + ) => + Clock domA -> ~ARG[5] Signal domA Bool -> ~ARG[6] Signal domA Bool -> ~ARG[7] @@ -168,7 +237,7 @@ Signal domB a -> ~ARG[14] (Signal domA a, Signal domB a) template: |- - // trueDualPortBlockRam begin + // trueDualPortBlockRamU begin // Shared memory reg [~SIZE[~TYP[9]]-1:0] ~GENSYM[mem][0] [~LIT[1]-1:0]; @@ -199,4 +268,4 @@ assign ~RESULT = {~SYM[1], ~SYM[2]}; - // end trueDualPortBlockRam + // end trueDualPortBlockRamU diff --git a/clash-lib/prims/vhdl/Clash_Explicit_BlockRam.primitives.yaml b/clash-lib/prims/vhdl/Clash_Explicit_BlockRam.primitives.yaml index 75a4f27358..4897f11828 100644 --- a/clash-lib/prims/vhdl/Clash_Explicit_BlockRam.primitives.yaml +++ b/clash-lib/prims/vhdl/Clash_Explicit_BlockRam.primitives.yaml @@ -181,6 +181,72 @@ , NFDataX a ~ARG[4] ) => + Vec nAddrs a -> ~ARG[5] + + Clock domA -> ~ARG[6] + Signal domA Bool -> ~ARG[7] + Signal domA Bool -> ~ARG[8] + Signal domA (Index nAddrs) -> ~ARG[9] + Signal domA a -> ~ARG[10] + + Clock domB -> ~ARG[11] + Signal domB Bool -> ~ARG[12] + Signal domB Bool -> ~ARG[13] + Signal domB (Index nAddrs) -> ~ARG[14] + Signal domB a -> ~ARG[15] + (Signal domA a, Signal domB a) + template: |- + -- trueDualPortBlockRam begin + ~GENSYM[~RESULT_trueDualPortBlockRam][1] : block + -- Shared memory + type mem_type is array ( ~LIT[1]-1 downto 0 ) of ~TYP[10]; + shared variable mem : mem_type := ~CONST[5]; + signal ~GENSYM[a_dout][2] : ~TYP[10]; + signal ~GENSYM[b_dout][3] : ~TYP[15]; + begin + + -- Port A + process(~ARG[6]) + begin + if(rising_edge(~ARG[6])) then + if(~ARG[7]) then + if(~ARG[8]) then + mem(~IF~SIZE[~TYP[9]]~THENto_integer(~ARG[9])~ELSE0~FI) := ~ARG[10]; + end if; + ~SYM[2] <= mem(~IF~SIZE[~TYP[9]]~THENto_integer(~ARG[9])~ELSE0~FI); + end if; + end if; + end process; + + -- Port B + process(~ARG[11]) + begin + if(rising_edge(~ARG[11])) then + if(~ARG[12]) then + if(~ARG[13]) then + mem(~IF~SIZE[~TYP[14]]~THENto_integer(~ARG[14])~ELSE0~FI) := ~ARG[15]; + end if; + ~SYM[3] <= mem(~IF~SIZE[~TYP[14]]~THENto_integer(~ARG[14])~ELSE0~FI); + end if; + end if; + end process; + + ~RESULT <= (~SYM[2], ~SYM[3]); + end block; + -- end trueDualPortBlockRam +- BlackBox: + name: Clash.Explicit.BlockRam.trueDualPortBlockRamU# + kind: Declaration + type: |- + trueDualPortBlockRamU# :: + forall nAddrs domA domB a . + ( HasCallStack ~ARG[0] + , KnownNat nAddrs ~ARG[1] + , KnownDomain domA ~ARG[2] + , KnownDomain domB ~ARG[3] + , NFDataX a ~ARG[4] + ) => + Clock domA -> ~ARG[5] Signal domA Bool -> ~ARG[6] Signal domA Bool -> ~ARG[7] @@ -194,7 +260,7 @@ Signal domB a -> ~ARG[14] (Signal domA a, Signal domB a) template: |- - -- trueDualPortBlockRam begin + -- trueDualPortBlockRamU begin ~GENSYM[~RESULT_trueDualPortBlockRam][1] : block -- Shared memory type mem_type is array ( ~LIT[1]-1 downto 0 ) of ~TYP[9]; @@ -231,4 +297,4 @@ ~RESULT <= (~SYM[2], ~SYM[3]); end block; - -- end trueDualPortBlockRam + -- end trueDualPortBlockRamU diff --git a/clash-prelude/src/Clash/Explicit/BlockRam.hs b/clash-prelude/src/Clash/Explicit/BlockRam.hs index f1f561c41e..f9b9560366 100644 --- a/clash-prelude/src/Clash/Explicit/BlockRam.hs +++ b/clash-prelude/src/Clash/Explicit/BlockRam.hs @@ -413,12 +413,14 @@ module Clash.Explicit.BlockRam -- * True dual-port block RAM -- $tdpbram , trueDualPortBlockRam + , trueDualPortBlockRamU , RamOp(..) -- * Internal , blockRam# , blockRamU# , blockRam1# , trueDualPortBlockRam# + , trueDualPortBlockRamU# ) where @@ -452,7 +454,7 @@ import Clash.Signal.Bundle (unbundle, bundle) import Clash.Signal.Internal.Ambiguous (clockPeriod) import Clash.Sized.Unsigned (Unsigned) import Clash.Sized.Index (Index) -import Clash.Sized.Vector (Vec, replicate, iterateI) +import Clash.Sized.Vector (Vec, replicate, iterateI, toList) import qualified Clash.Sized.Vector as CV import Clash.XException (maybeIsX, NFDataX(deepErrorX), defaultSeqX, fromJustX, undefined, @@ -1174,6 +1176,8 @@ isOp :: RamOp n a -> Bool isOp RamNoOp = False isOp _ = True + + -- | Produces vendor-agnostic HDL that will be inferred as a true dual-port -- block RAM -- @@ -1189,7 +1193,11 @@ trueDualPortBlockRam :: , KnownDomain domB , NFDataX a ) - => Clock domA + => Vec nAddrs a + -- ^ Initial content of the BRAM + -- + -- __NB__: __MUST__ be a constant + -> Clock domA -- ^ Clock for port A -> Clock domB -- ^ Clock for port B @@ -1202,8 +1210,37 @@ trueDualPortBlockRam :: -- will be echoed. When reading, the read data is returned. {-# INLINE trueDualPortBlockRam #-} -trueDualPortBlockRam = \clkA clkB opA opB -> - trueDualPortBlockRamWrapper +trueDualPortBlockRam = \content clkA clkB opA opB -> + trueDualPortBlockRamWrapper content + clkA (isOp <$> opA) (isRamWrite <$> opA) (ramOpAddr <$> opA) (fromJustX . ramOpWriteVal <$> opA) + clkB (isOp <$> opB) (isRamWrite <$> opB) (ramOpAddr <$> opB) (fromJustX . ramOpWriteVal <$> opB) + + + +-- | A version of 'trueDualPortBlockRam' that has no default values set. +trueDualPortBlockRamU :: + forall nAddrs domA domB a . + ( HasCallStack + , KnownNat nAddrs + , KnownDomain domA + , KnownDomain domB + , NFDataX a + ) + => Clock domA + -- ^ Clock for port A + -> Clock domB + -- ^ Clock for port B + -> Signal domA (RamOp nAddrs a) + -- ^ RAM operation for port A + -> Signal domB (RamOp nAddrs a) + -- ^ RAM operation for port B + -> (Signal domA a, Signal domB a) + -- ^ Outputs data on /next/ cycle. When writing, the data written + -- will be echoed. When reading, the read data is returned. + +{-# INLINE trueDualPortBlockRamU #-} +trueDualPortBlockRamU = \clkA clkB opA opB -> + trueDualPortBlockRamUWrapper clkA (isOp <$> opA) (isRamWrite <$> opA) (ramOpAddr <$> opA) (fromJustX . ramOpWriteVal <$> opA) clkB (isOp <$> opB) (isRamWrite <$> opB) (ramOpAddr <$> opB) (fromJustX . ramOpWriteVal <$> opB) @@ -1221,7 +1258,7 @@ data Conflict = Conflict , cfWW :: !(MaybeX Bool) -- ^ Write/Write conflict , cfAddress :: !(MaybeX Int) } --- [Note: eta port names for trueDualPortBlockRam] +-- [Note: eta port names for trueDualPortBlockRam and trueDualPortBlockRamU] -- -- By naming all the arguments and setting the -fno-do-lambda-eta-expansion GHC -- option for this module, the generated HDL also contains names based on the @@ -1234,10 +1271,16 @@ data Conflict = Conflict -- logic to the module / architecture, and synthesis will no longer infer a -- multi-clock true dual-port block RAM. This wrapper pushes the primitive out -- into its own module / architecture. -trueDualPortBlockRamWrapper clkA enA weA addrA datA clkB enB weB addrB datB = - trueDualPortBlockRam# clkA enA weA addrA datA clkB enB weB addrB datB +trueDualPortBlockRamWrapper content clkA enA weA addrA datA clkB enB weB addrB datB = + trueDualPortBlockRam# content clkA enA weA addrA datA clkB enB weB addrB datB {-# NOINLINE trueDualPortBlockRamWrapper #-} + +trueDualPortBlockRamUWrapper clkA enA weA addrA datA clkB enB weB addrB datB = + trueDualPortBlockRamU# clkA enA weA addrA datA clkB enB weB addrB datB +{-# NOINLINE trueDualPortBlockRamUWrapper #-} + + -- | Primitive of 'trueDualPortBlockRam'. trueDualPortBlockRam#, trueDualPortBlockRamWrapper :: forall nAddrs domA domB a . @@ -1247,7 +1290,11 @@ trueDualPortBlockRam#, trueDualPortBlockRamWrapper :: , KnownDomain domB , NFDataX a ) - => Clock domA + => Vec nAddrs a + -- ^ Initial content of the BRAM + -- + -- __NB__: __MUST__ be a constant + -> Clock domA -- ^ Clock for port A -> Signal domA Bool -- ^ Enable for port A @@ -1273,19 +1320,70 @@ trueDualPortBlockRam#, trueDualPortBlockRamWrapper :: -- ^ Outputs data on /next/ cycle. If write enable is @True@, the data written -- will be echoed. If write enable is @False@, the read data is returned. If -- port enable is @False@, it is /undefined/. -trueDualPortBlockRam# clkA enA weA addrA datA clkB enB weB addrB datB +trueDualPortBlockRam# contents clkA enA weA addrA datA clkB enB weB addrB datB | snatToNum @Int (clockPeriod @domA) < snatToNum @Int (clockPeriod @domB) - = swap (trueDualPortBlockRamModel labelB clkB enB weB addrB datB labelA clkA enA weA addrA datA) + = swap (trueDualPortBlockRamModel contents' labelB clkB enB weB addrB datB labelA clkA enA weA addrA datA) | otherwise - = trueDualPortBlockRamModel labelA clkA enA weA addrA datA labelB clkB enB weB addrB datB + = trueDualPortBlockRamModel contents' labelA clkA enA weA addrA datA labelB clkB enB weB addrB datB where - labelA = "Port A" - labelB = "Port B" + labelA = "Port A" + labelB = "Port B" + contents' = Seq.fromList (toList contents) {-# NOINLINE trueDualPortBlockRam# #-} {-# ANN trueDualPortBlockRam# hasBlackBox #-} --- | Haskell model for the primitive 'trueDualPortBlockRam#'. +-- | Primitive of 'trueDualPortBlockRamU'. +trueDualPortBlockRamU#, trueDualPortBlockRamUWrapper :: + forall nAddrs domA domB a . + ( HasCallStack + , KnownNat nAddrs + , KnownDomain domA + , KnownDomain domB + , NFDataX a + ) + => Clock domA + -- ^ Clock for port A + -> Signal domA Bool + -- ^ Enable for port A + -> Signal domA Bool + -- ^ Write enable for port A + -> Signal domA (Index nAddrs) + -- ^ Address to read from or write to on port A + -> Signal domA a + -- ^ Data in for port A; ignored when /write enable/ is @False@ + + -> Clock domB + -- ^ Clock for port B + -> Signal domB Bool + -- ^ Enable for port B + -> Signal domB Bool + -- ^ Write enable for port B + -> Signal domB (Index nAddrs) + -- ^ Address to read from or write to on port B + -> Signal domB a + -- ^ Data in for port B; ignored when /write enable/ is @False@ + + -> (Signal domA a, Signal domB a) + -- ^ Outputs data on /next/ cycle. If write enable is @True@, the data written + -- will be echoed. If write enable is @False@, the read data is returned. If + -- port enable is @False@, it is /undefined/. +trueDualPortBlockRamU# clkA enA weA addrA datA clkB enB weB addrB datB + | snatToNum @Int (clockPeriod @domA) < snatToNum @Int (clockPeriod @domB) + = swap (trueDualPortBlockRamModel contents labelB clkB enB weB addrB datB labelA clkA enA weA addrA datA) + | otherwise + = trueDualPortBlockRamModel contents labelA clkA enA weA addrA datA labelB clkB enB weB addrB datB + where + labelA = "Port A" + labelB = "Port B" + contents = Seq.fromFunction (natToNum @nAddrs) initElement + + initElement n = deepErrorX ("Unknown initial element; position " <> show n) +{-# NOINLINE trueDualPortBlockRamU# #-} +{-# ANN trueDualPortBlockRamU# hasBlackBox #-} + + +-- | Haskell model for the primitives 'trueDualPortBlockRam#' and 'trueDualPortBlockRamU#'. -- -- Warning: this model only works if @domFast@'s clock is faster (or equal to) -- @domSlow@'s clock. @@ -1298,6 +1396,8 @@ trueDualPortBlockRamModel :: , NFDataX a ) => + Seq a -> + String -> Clock domSlow -> Signal domSlow Bool -> @@ -1313,13 +1413,13 @@ trueDualPortBlockRamModel :: Signal domFast a -> (Signal domSlow a, Signal domFast a) -trueDualPortBlockRamModel labelA !_clkA enA weA addrA datA labelB !_clkB enB weB addrB datB = +trueDualPortBlockRamModel contents labelA !_clkA enA weA addrA datA labelB !_clkB enB weB addrB datB = ( startA :- outA , startB :- outB ) where (outA, outB) = go - (Seq.fromFunction (natToNum @nAddrs) initElement) + contents tB -- ensure 'go' hits fast clock first for 1 cycle, then execute slow -- clock for 1 cycle, followed by the regular cadence of 'ceil(tA / tB)' -- cycles for the fast clock followed by 1 cycle of the slow clock @@ -1333,9 +1433,7 @@ trueDualPortBlockRamModel labelA !_clkA enA weA addrA datA labelB !_clkB enB weB startA = deepErrorX $ "trueDualPortBlockRam: " <> labelA <> ": First value undefined" startB = deepErrorX $ "trueDualPortBlockRam: " <> labelB <> ": First value undefined" - initElement :: Int -> a - initElement n = - deepErrorX ("Unknown initial element; position " <> show n) + unknownEnableAndAddr :: String -> String -> Int -> a unknownEnableAndAddr enaMsg addrMsg n = diff --git a/clash-prelude/src/Clash/Explicit/Prelude.hs b/clash-prelude/src/Clash/Explicit/Prelude.hs index 2c2e0930a1..343908c583 100644 --- a/clash-prelude/src/Clash/Explicit/Prelude.hs +++ b/clash-prelude/src/Clash/Explicit/Prelude.hs @@ -66,6 +66,7 @@ module Clash.Explicit.Prelude , readNew -- ** True dual-port block RAM , trueDualPortBlockRam + , trueDualPortBlockRamU , RamOp(..) -- * Utility functions , window diff --git a/clash-prelude/src/Clash/Explicit/Prelude/Safe.hs b/clash-prelude/src/Clash/Explicit/Prelude/Safe.hs index 487824f78b..78244997ac 100644 --- a/clash-prelude/src/Clash/Explicit/Prelude/Safe.hs +++ b/clash-prelude/src/Clash/Explicit/Prelude/Safe.hs @@ -57,6 +57,7 @@ module Clash.Explicit.Prelude.Safe , readNew -- ** True dual-port block RAM , trueDualPortBlockRam + , trueDualPortBlockRamU , RamOp(..) -- * Utility functions , isRising diff --git a/clash-prelude/src/Clash/Explicit/Synchronizer.hs b/clash-prelude/src/Clash/Explicit/Synchronizer.hs index cf4ed7873f..9bd2a80315 100644 --- a/clash-prelude/src/Clash/Explicit/Synchronizer.hs +++ b/clash-prelude/src/Clash/Explicit/Synchronizer.hs @@ -38,7 +38,7 @@ import Clash.Class.BitPack (boolToBV, unpack) import Clash.Class.Resize (truncateB) import Clash.Class.BitPack.BitIndex (slice) import Clash.Explicit.Mealy (mealyB) -import Clash.Explicit.BlockRam (RamOp (..), trueDualPortBlockRam) +import Clash.Explicit.BlockRam (RamOp (..), trueDualPortBlockRamU) import Clash.Explicit.Signal (Clock, Reset, Signal, Enable, register, unsafeSynchronizer, fromEnable, (.&&.)) import Clash.Promoted.Nat (SNat (..)) @@ -113,7 +113,7 @@ fifoMem -> Signal wdom (Maybe a) -> Signal rdom a fifoMem wclk rclk wen ren full raddr waddr wdataM = - fst $ trueDualPortBlockRam + fst $ trueDualPortBlockRamU rclk wclk portA portB where portA :: Signal rdom (RamOp (2 ^ addrSize) a) diff --git a/clash-prelude/src/Clash/Prelude.hs b/clash-prelude/src/Clash/Prelude.hs index f88a893033..365f95a672 100644 --- a/clash-prelude/src/Clash/Prelude.hs +++ b/clash-prelude/src/Clash/Prelude.hs @@ -93,7 +93,7 @@ module Clash.Prelude -- ** Block RAM read/write conflict resolution , readNew -- ** True dual-port block RAM - , trueDualPortBlockRam + , trueDualPortBlockRamU , RamOp(..) -- * Utility functions , window diff --git a/clash-prelude/src/Clash/Prelude/BlockRam.hs b/clash-prelude/src/Clash/Prelude/BlockRam.hs index 19e4b80085..e77fe2cf67 100644 --- a/clash-prelude/src/Clash/Prelude/BlockRam.hs +++ b/clash-prelude/src/Clash/Prelude/BlockRam.hs @@ -397,6 +397,7 @@ module Clash.Prelude.BlockRam -- * True dual-port block RAM -- $tdpbram , trueDualPortBlockRam + , trueDualPortBlockRamU , E.RamOp(..) ) where @@ -868,6 +869,50 @@ readNew = hideClockResetEnable E.readNew -- is: WriteFirst. For mixed-port read/write, when port A writes to the address -- port B reads from, the output of port B is undefined, and vice versa. trueDualPortBlockRam :: +#ifdef CLASH_MULTIPLE_HIDDEN + forall nAddrs dom1 dom2 a . + ( HasCallStack + , KnownNat nAddrs + , HiddenClock dom1 + , HiddenClock dom2 + , NFDataX a + ) + => Vec nAddrs a + -- ^ Initial content of the BRAM + -- + -- __NB__: __MUST__ be a constant + -> Signal dom1 (E.RamOp nAddrs a) + -- ^ RAM operation for port A + -> Signal dom2 (E.RamOp nAddrs a) + -- ^ RAM operation for port B + -> (Signal dom1 a, Signal dom2 a) + -- ^ Outputs data on /next/ cycle. When writing, the data written + -- will be echoed. When reading, the read data is returned. +trueDualPortBlockRam contents inA inB = + E.trueDualPortBlockRam contents (hasClock @dom1) (hasClock @dom2) inA inB +#else + forall nAddrs dom a . + ( HasCallStack + , KnownNat nAddrs + , HiddenClock dom + , NFDataX a + ) + => Vec nAddrs a + -- ^ Initial content of the BRAM + -- + -- __NB__: __MUST__ be a constant + -> Signal dom (E.RamOp nAddrs a) + -- ^ RAM operation for port A + -> Signal dom (E.RamOp nAddrs a) + -- ^ RAM operation for port B + -> (Signal dom a, Signal dom a) + -- ^ Outputs data on /next/ cycle. When writing, the data written + -- will be echoed. When reading, the read data is returned. +trueDualPortBlockRam contents inA inB = E.trueDualPortBlockRam contents hasClock hasClock inA inB +#endif + +-- | A version of 'trueDualPortBlockRam' that has no default values set. +trueDualPortBlockRamU :: #ifdef CLASH_MULTIPLE_HIDDEN forall nAddrs dom1 dom2 a . ( HasCallStack @@ -883,8 +928,8 @@ trueDualPortBlockRam :: -> (Signal dom1 a, Signal dom2 a) -- ^ Outputs data on /next/ cycle. When writing, the data written -- will be echoed. When reading, the read data is returned. -trueDualPortBlockRam inA inB = - E.trueDualPortBlockRam (hasClock @dom1) (hasClock @dom2) inA inB +trueDualPortBlockRamU inA inB = + E.trueDualPortBlockRamU (hasClock @dom1) (hasClock @dom2) inA inB #else forall nAddrs dom a . ( HasCallStack @@ -899,5 +944,5 @@ trueDualPortBlockRam inA inB = -> (Signal dom a, Signal dom a) -- ^ Outputs data on /next/ cycle. When writing, the data written -- will be echoed. When reading, the read data is returned. -trueDualPortBlockRam inA inB = E.trueDualPortBlockRam hasClock hasClock inA inB +trueDualPortBlockRamU inA inB = E.trueDualPortBlockRamU hasClock hasClock inA inB #endif diff --git a/clash-prelude/src/Clash/Prelude/Safe.hs b/clash-prelude/src/Clash/Prelude/Safe.hs index c18c06d280..dca61170a0 100644 --- a/clash-prelude/src/Clash/Prelude/Safe.hs +++ b/clash-prelude/src/Clash/Prelude/Safe.hs @@ -73,6 +73,7 @@ module Clash.Prelude.Safe , readNew -- ** True dual-port block RAM , trueDualPortBlockRam + , trueDualPortBlockRamU , RamOp(..) -- * Utility functions , isRising diff --git a/tests/shouldwork/Signal/DualBlockRamDefinitions.hs b/tests/shouldwork/Signal/DualBlockRamDefinitions.hs index 6727c6f62c..a8f928a239 100644 --- a/tests/shouldwork/Signal/DualBlockRamDefinitions.hs +++ b/tests/shouldwork/Signal/DualBlockRamDefinitions.hs @@ -1,11 +1,13 @@ {-# OPTIONS_GHC -Wno-orphans -Wno-missing-signatures #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TemplateHaskell #-} module DualBlockRamDefinitions where import qualified Prelude as P -import Clash.Explicit.Prelude - +import Clash.Explicit.Prelude hiding (fromList) +import Clash.Sized.Vector(fromList) +import Language.Haskell.TH import DualBlockRamTypes createDomain vSystem{vName="A", vPeriod=hzToPeriod 20e6} -- fast @@ -13,7 +15,9 @@ createDomain vSystem{vName="B", vPeriod=hzToPeriod 10e6} -- slow createDomain vSystem{vName="C", vPeriod=hzToPeriod 7e6} -- slower tdpRam :: (KnownDomain domA, KnownDomain domB) => TdpRam domA domB -tdpRam = trueDualPortBlockRam +tdpRam = trueDualPortBlockRam content + where + Just content = $(lift $ fromList @73 $ P.take 73 ((cycle [This, That . truncateB]) <*> [0..])) {- Testvectors Test0 : Write to different addresses and check if value is present at output. diff --git a/tests/shouldwork/Signal/T2069.hs b/tests/shouldwork/Signal/T2069.hs index 4c29a6cbbb..16bd2c79c1 100644 --- a/tests/shouldwork/Signal/T2069.hs +++ b/tests/shouldwork/Signal/T2069.hs @@ -10,7 +10,7 @@ topEntity -> Signal System (RamOp 1 (Unsigned 8)) -> Signal System (RamOp 1 (Unsigned 8)) -> (Signal System (Unsigned 8), Signal System (Unsigned 8)) -topEntity = trueDualPortBlockRam +topEntity = trueDualPortBlockRamU {-# NOINLINE topEntity #-} testBench :: Signal System Bool