Add Xilinx dual clock FIFO primitive

Co-authored-by: Martijn Bastiaan <[email protected]>

clash-cores/clash-cores.cabal

@@ -68,13 +68,18 @@ common basic-config
     ghc-typelits-knownnat     >= 0.6,
     interpolate               >= 0.2,
     QuickCheck,
-    template-haskell
+    template-haskell,
+    containers                >=0.5    && <0.7
 
 library
   import: basic-config
   hs-source-dirs: src
 
   exposed-modules:
+    Clash.Cores.Xilinx.Common
+    Clash.Cores.Xilinx.DcFifo.BlackBoxes
+    Clash.Cores.Xilinx.DcFifo.Explicit
+    Clash.Cores.Xilinx.DcFifo.Instances
     Clash.Cores.Xilinx.Floating
     Clash.Cores.Xilinx.Floating.Annotations
     Clash.Cores.Xilinx.Floating.BlackBoxes
@@ -112,9 +117,13 @@ test-suite unittests
     Test.Cores.SPI
     Test.Cores.UART
     Test.Cores.SPI.MultiSlave
+    Test.Cores.Xilinx.DcFifo
 
   build-depends:
     clash-cores,
+    clash-lib,
     tasty        >= 1.2 && < 1.3,
     tasty-hunit,
-    tasty-quickcheck
+    tasty-quickcheck,
+    hedgehog,
+    tasty-hedgehog >= 1.2.0

clash-cores/src/Clash/Cores/Xilinx/Common.hs

@@ -0,0 +1,85 @@
+{-|
+  Copyright   :  (C) 2022 Google Inc
+  License     :  BSD2 (see the file LICENSE)
+  Maintainer  :  QBayLogic B.V. <[email protected]>
+
+  Common utilities for defining Xilinx IP primitives.
+-}
+
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Clash.Cores.Xilinx.Common where
+
+import Prelude
+
+import Clash.Netlist.Id (Identifier)
+import Data.String (fromString)
+import Data.String.Interpolate (i)
+import Data.String.Interpolate.Util (unindent)
+import Data.Text.Prettyprint.Doc.Extra (Doc)
+
+import qualified Clash.Netlist.Id as Id
+import qualified Data.Text as Text
+import Data.List (intercalate)
+
+type PropName = String
+type PropValue = String
+type Property = (PropName, PropValue)
+
+data IpConfig = IpConfig
+  { name :: String
+  , vendor :: String
+  , library :: String
+  , version :: String
+  , moduleName :: Identifier
+  , properties :: [Property]
+  }
+
+defIpConfig ::
+  -- | Name of IP core. For example: \"fifo_generator\".
+  String ->
+  -- | Version of IP core. For example: \"13.2\".
+  String ->
+  -- | Name of module the IP core should be generated as. For example: \"dcfifo\". This
+  -- name should be unique. See "Clash.Netlist.Id" for more information on how to
+  -- generate unique identifiers.
+  Identifier ->
+  -- | Configuration with sensible defaults.
+  IpConfig
+defIpConfig name_ version_ moduleName_ = IpConfig
+  { name = name_
+  , version = version_
+  , moduleName = moduleName_
+  , vendor = "xilinx.com"
+  , library = "ip"
+  , properties = []
+  }
+
+renderTcl :: IpConfig -> Doc
+renderTcl IpConfig{..} =
+  fromString $ unindent [i|
+    create_ip \\
+      -name #{name} \\
+      -vendor #{vendor} \\
+      -library #{library} \\
+      -version #{version} \\
+      -module_name {#{moduleNameString}}
+
+    set_property -dict [list \\
+#{renderedProperties}
+                       ] \\
+                      [get_ips {#{moduleNameString}}]
+
+    generate_target {synthesis simulation} [get_ips {#{moduleNameString}}]
+  |]
+
+ where
+  moduleNameString = Text.unpack (Id.toText moduleName)
+  renderedProperties = intercalate "\n" (map prop properties)
+  prop (name_, value) = [i|#{indent}CONFIG.#{name_} {#{value}} \\|]
+  indent = replicate 25 ' '
+
+toTclBool :: Bool -> String
+toTclBool True = "true"
+toTclBool False = "false"

clash-cores/src/Clash/Cores/Xilinx/DcFifo/BlackBoxes.hs

@@ -0,0 +1,191 @@
+{-|
+  Copyright   :  (C) 2022 Google Inc
+  License     :  BSD2 (see the file LICENSE)
+  Maintainer  :  QBayLogic B.V. <[email protected]>
+
+  Blackbox implementation for primitives in "Clash.Cores.Xilinx.DcFifo.Explicit".
+-}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Clash.Cores.Xilinx.DcFifo.BlackBoxes where
+
+import Prelude
+
+import Clash.Core.Literal (Literal(NaturalLiteral))
+import Clash.Core.TermLiteral (termToDataError, TermLiteralSNat(..))
+import Clash.Core.Term (Term(Literal))
+import qualified Clash.Primitives.DSL as DSL
+import Clash.Netlist.BlackBox.Types (BlackBoxFunction, emptyBlackBoxMeta)
+import Clash.Netlist.Types (TemplateFunction(..), BlackBox(BBFunction))
+import Clash.Netlist.Util (orNothing)
+
+import Clash.Netlist.Id (Identifier)
+import qualified Clash.Netlist.Id as Id
+import qualified Clash.Netlist.Types as N
+import qualified Clash.Netlist.BlackBox.Types as N
+
+import Control.Monad (unless)
+import Data.Either (lefts)
+import Data.Maybe (catMaybes)
+import GHC.Stack (HasCallStack)
+
+import Clash.Cores.Xilinx.DcFifo.Explicit (DcConfig(..))
+import Clash.Cores.Xilinx.DcFifo.Instances ()
+import Clash.Cores.Xilinx.Common (toTclBool, renderTcl, defIpConfig, IpConfig (properties))
+
+-- | Blackbox function for 'Clash.Cores.Xilinx.Fifo.dcFifo'. It parses the "DcConfig"
+-- supplied to 'dcFifo' from its Term representation, and passes them to two
+-- template functions:
+--
+--   * 'dcFifoTclTF': renders TCL file calling Xilinx's `create_ip`
+--   * 'dcFifoTF': instantiates IP generated in 'dcFifoTclTF'
+--
+-- Additionally, it generates an unique module name for the Xilinx IP.
+--
+dcFifoBBF :: HasCallStack => BlackBoxFunction
+dcFifoBBF _isD _primName args _resTys = do
+  let
+    [  knownNatN, _knownDomainWrite, _knownDomainRead, _knownNatDepth
+     , _constraint1, _constraint2
+     , either error id . termToDataError -> dcConfig
+     , _wClk, _rClk, _rst, _wData
+     , _wEnable, _rEnable
+
+    -- TODO: Make this blackbox return multiple results, instead of a tuple. See:
+    --       https://github.com/clash-lang/clash-compiler/pull/1560
+    --  , _, _, _, _, _, _, _
+     ] = lefts args
+
+  dcFifoName <- Id.makeBasic "dcfifo"
+
+  let depth =
+        case knownNatN of
+          Literal (NaturalLiteral n) -> fromInteger n
+          _ -> error "Unexpected type of knownNatN!"
+
+  pure (Right (bbMeta depth dcFifoName dcConfig, bb dcFifoName dcConfig))
+ where
+  bbMeta width dcFifoName dcConfig = emptyBlackBoxMeta
+    { N.bbKind = N.TDecl
+    , N.bbIncludes =
+      [ ( ("dcfifo", "tcl")
+        , BBFunction (show 'dcFifoTclTF) 0 (dcFifoTclTF width dcFifoName dcConfig))
+      ]
+    -- TODO: Make this blackbox return multiple results, instead of a tuple. See:
+    --       https://github.com/clash-lang/clash-compiler/pull/1560
+    -- , N.bbResultNames =
+    --   [ N.BBTemplate [N.Text "wr_reset_busy"]
+    --   , N.BBTemplate [N.Text "wr_full"]
+    --   , N.BBTemplate [N.Text "wr_data_count"]
+
+    --   , N.BBTemplate [N.Text "rd_reset_busy"]
+    --   , N.BBTemplate [N.Text "rd_empty"]
+    --   , N.BBTemplate [N.Text "rd_data_count"]
+    --   , N.BBTemplate [N.Text "rd_dout"]
+    --   ]
+    }
+
+  bb :: Identifier -> DcConfig TermLiteralSNat -> BlackBox
+  bb dcFifoName dcConfig = BBFunction (show 'dcFifoTF) 0 (dcFifoTF dcFifoName dcConfig)
+
+-- | Instantiate IP generate with 'dcFifoTclTF'.
+dcFifoTF :: Identifier -> DcConfig TermLiteralSNat -> TemplateFunction
+dcFifoTF dcFifoName DcConfig{..} = TemplateFunction [] (const True) $ \bbCtx -> do
+  let
+    TermLiteralSNat (fromIntegral -> depth) = dcDepth
+
+    [  _knownNatN, _knownDomainWrite, _knownDomainRead, _knownNatDepth
+     , _constraint1, _constraint2
+     , _dcConfig
+     , wClk, rClk, rst, wData
+     , wEnable, rEnable
+     ] = map fst (DSL.tInputs bbCtx)
+
+    [tResult] = map DSL.ety (DSL.tResults bbCtx)
+
+  dcFifoInstName <- Id.makeBasic "dcfifo_inst"
+
+  DSL.declarationReturn bbCtx "dcfifo_inst_block" $ do
+    wrResetBusy <- DSL.declare "wr_reset_busy" N.Wire N.Bit
+    wrFull      <- DSL.declare "wr_full"       N.Wire N.Bit
+    wrDataCount <- DSL.declare "wr_data_count" N.Wire (N.BitVector depth)
+    rdResetBusy <- DSL.declare "rd_reset_busy" N.Wire N.Bit
+    rdEmpty     <- DSL.declare "rd_empty"      N.Wire N.Bit
+    rdDataCount <- DSL.declare "rd_data_count" N.Wire (N.BitVector depth)
+    rdDout      <- DSL.declare "rd_dout"       N.Wire (DSL.ety wData)
+
+    wrFullBool  <- DSL.boolFromBit "wr_full_bool" wrFull
+    rdEmptyBool <- DSL.boolFromBit "rd_empty_bool" rdEmpty
+
+    wEnableBit <- DSL.boolToBit "wr_enable" wEnable
+    rEnableBit <- DSL.boolToBit "rd_enable" rEnable
+
+    wrDataCountUnsigned <- DSL.unsignedFromBitVector "wr_data_count_unsigned" wrDataCount
+    rdDataCountUnsigned <- DSL.unsignedFromBitVector "wr_data_count_unsigned" rdDataCount
+
+    wrResetBusyBool <- DSL.boolFromBit "wr_reset_busy_bool" wrResetBusy
+    rdResetBusyBool <- DSL.boolFromBit "rd_reset_busy_bool" rdResetBusy
+
+    let
+      inps =
+        [ ("rst", rst)
+        , ("wr_clk", wClk)
+        , ("rd_clk", rClk)
+        , ("din", wData)
+        , ("wr_en", wEnableBit)
+        , ("rd_en", rEnableBit)
+        ]
+
+      outs = catMaybes
+        [ Just ("wr_rst_busy", wrResetBusy)
+        , Just ("rd_rst_busy", rdResetBusy)
+        , Just ("full", wrFull)
+        , Just ("empty", rdEmpty)
+        , Just ("dout", rdDout)
+        , dcReadDataCount  `orNothing` ("rd_data_count", rdDataCount)
+        , dcWriteDataCount `orNothing` ("wr_data_count", wrDataCount)
+        ]
+
+      DSL.TExpr _ (N.Identifier rdDataCountId Nothing) = rdDataCount
+      DSL.TExpr _ (N.Identifier wrDataCountId Nothing) = wrDataCount
+
+    unless dcReadDataCount $
+      DSL.addDeclaration (N.Assignment rdDataCountId (DSL.eex (DSL.bvLit depth 0)))
+
+    unless dcWriteDataCount $
+      DSL.addDeclaration (N.Assignment wrDataCountId (DSL.eex (DSL.bvLit depth 0)))
+
+    DSL.instDecl N.Entity dcFifoName dcFifoInstName [] inps outs
+
+    pure [DSL.constructProduct
+      tResult
+      [ wrResetBusyBool, wrFullBool, wrDataCountUnsigned
+      , rdResetBusyBool, rdEmptyBool, rdDataCountUnsigned, rdDout
+      ]]
+
+-- | Generate TCL file that calls Xilinx's `create_ip` with the options supplied
+-- in the second argument.
+dcFifoTclTF :: Int -> Identifier -> DcConfig TermLiteralSNat -> TemplateFunction
+dcFifoTclTF width dcFifoName DcConfig{..} =
+  TemplateFunction [] (const True) (const (pure (renderTcl ipConfig)))
+ where
+  ipConfig = (defIpConfig "fifo_generator" "13.2" dcFifoName){properties = props}
+  TermLiteralSNat depth = dcDepth
+
+  props =
+    [ ("Fifo_Implementation",    show dcImplementation)
+    , ("Performance_Options",    show dcReadMode)
+    , ("Reset_Type",             "Asynchronous_Reset")
+    , ("Full_Flags_Reset_Value", "1")
+    , ("Input_Data_Width", show width)
+    , ("Output_Data_Width", show width)
+    , ("Write_Data_Count",       toTclBool dcWriteDataCount)
+    , ("Write_Data_Count_Width", show depth)
+    , ("Read_Data_Count",        toTclBool dcReadDataCount)
+    , ("Read_Data_Count_Width",  show depth)
+    , ("Enable_Safety_Circuit",  toTclBool True)
+    ]