diff --git a/changelog/2023-02-05T12_23_02+01_00_clocks-lock b/changelog/2023-02-05T12_23_02+01_00_clocks-lock new file mode 100644 index 0000000000..044146307b --- /dev/null +++ b/changelog/2023-02-05T12_23_02+01_00_clocks-lock @@ -0,0 +1,5 @@ +FIXED: The Haskell simulation of the PLL lock signal in `Clash.Clocks` (used by +`Clash.Intel.ClockGen`) is fixed: the signal is now unasserted for the time the +reset input is asserted and vice versa, and no longer crashes the simulation. +HDL generation is unchanged. The PLL functions now have an additional +constraint: `KnownDomain pllLock`. diff --git a/clash-prelude/clash-prelude.cabal b/clash-prelude/clash-prelude.cabal index fccb002687..c9bec65fc8 100644 --- a/clash-prelude/clash-prelude.cabal +++ b/clash-prelude/clash-prelude.cabal @@ -51,7 +51,7 @@ Maintainer: QBayLogic B.V. Copyright: Copyright © 2013-2016, University of Twente, 2016-2017, Myrtle Software Ltd, 2017-2019, QBayLogic B.V., Google Inc., - 2021-2022, QBayLogic B.V. + 2021-2023, QBayLogic B.V. Category: Hardware Build-type: Simple @@ -410,6 +410,7 @@ test-suite unittests Clash.Tests.BitVector Clash.Tests.BlockRam Clash.Tests.BlockRam.Blob + Clash.Tests.Clocks Clash.Tests.Counter Clash.Tests.DerivingDataRepr Clash.Tests.DerivingDataReprTypes diff --git a/clash-prelude/src/Clash/Clocks/Deriving.hs b/clash-prelude/src/Clash/Clocks/Deriving.hs index 9a00395fa4..8553e8f69a 100644 --- a/clash-prelude/src/Clash/Clocks/Deriving.hs +++ b/clash-prelude/src/Clash/Clocks/Deriving.hs @@ -1,8 +1,9 @@ {-| Copyright : (C) 2018-2022, Google Inc 2019, Myrtle Software Ltd + 2023, QBayLogic B.V. License : BSD2 (see the file LICENSE) -Maintainer : Christiaan Baaij +Maintainer : QBayLogic B.V. -} {-# LANGUAGE CPP #-} @@ -12,6 +13,7 @@ Maintainer : Christiaan Baaij module Clash.Clocks.Deriving (deriveClocksInstances) where import Control.Monad (foldM) +import Clash.Explicit.Signal (unsafeSynchronizer) import Clash.Signal.Internal import Language.Haskell.TH.Compat import Language.Haskell.TH.Syntax @@ -33,12 +35,14 @@ derive' n = do instType1 <- AppT instType0 <$> lockType let instHead = AppT (ConT $ mkName "Clocks") instType1 - cxtRHS <- foldM (\a n' -> AppT a <$> knownDomainCxt n') (TupleT n) [1..n] + cxtRHS0 <- + foldM (\a n' -> AppT a <$> knownDomainCxt n') (TupleT $ n + 1) [1..n] + cxtRHS1 <- AppT cxtRHS0 <$> lockKnownDomainCxt #if MIN_VERSION_template_haskell(2,15,0) let cxtLHS = AppT (ConT $ mkName "ClocksCxt") instType1 - let cxtTy = TySynInstD (TySynEqn Nothing cxtLHS cxtRHS) + let cxtTy = TySynInstD (TySynEqn Nothing cxtLHS cxtRHS1) #else - let cxtTy = TySynInstD (mkName "ClocksCxt") (TySynEqn [instType1] cxtRHS) + let cxtTy = TySynInstD (mkName "ClocksCxt") (TySynEqn [instType1] cxtRHS1) #endif -- Function definition of 'clocks' @@ -46,10 +50,12 @@ derive' n = do let rst = mkName "rst" -- Implementation of 'clocks' + lockImpl <- [| unsafeSynchronizer clockGen clockGen + (unsafeToLowPolarity $(varE rst)) |] let noInline = PragmaD $ InlineP (mkName "clocks") NoInline FunLike AllPhases clkImpls = replicate n (clkImpl clk) - instTuple = mkTupE $ clkImpls ++ [AppE (VarE 'unsafeCoerce) (VarE rst)] + instTuple = mkTupE $ clkImpls ++ [lockImpl] funcBody = NormalB instTuple errMsg = "clocks: dynamic clocks unsupported" errBody = NormalB ((VarE 'error) `AppE` (LitE (StringL errMsg))) @@ -81,6 +87,11 @@ derive' n = do let c = varT $ mkName "pllLock" in [t| Signal $c Bool |] + lockKnownDomainCxt = + let p = varT $ mkName "pllLock" in + [t| KnownDomain $p |] + + clkImpl clk = AppE (VarE 'unsafeCoerce) (VarE clk) -- Derive instances for up to and including to /n/ clocks diff --git a/clash-prelude/tests/Clash/Tests/Clocks.hs b/clash-prelude/tests/Clash/Tests/Clocks.hs new file mode 100644 index 0000000000..3f5dbd4e3d --- /dev/null +++ b/clash-prelude/tests/Clash/Tests/Clocks.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-unused-top-binds #-} + +module Clash.Tests.Clocks(tests) where + +import qualified Prelude as P + +import Test.Tasty +import Test.Tasty.HUnit + +import Clash.Explicit.Prelude +import Clash.Intel.ClockGen (altpll) + +-- Ratio of clock periods in 'createDomain' and 'resetLen' are chosen, rest is +-- derived from that + +createDomain vSystem{vName="ClocksSlow", vPeriod=3 * vPeriod vSystem} + +resetLen :: SNat 10 +resetLen = SNat + +lockResampled :: Assertion +lockResampled = + unlockedLenSeen @?= unlockedLen + where + pll :: + Clock ClocksSlow -> + Reset ClocksSlow -> + (Clock System, Signal System Bool) + pll = altpll (SSymbol @"pll") + + unlockedLenSeen = + P.length . P.takeWhile not . + -- Arbitrary cut-off so simulation always ends + sampleN (unlockedLen + 100) . + snd $ pll clockGen (resetGenN resetLen) + +clockRatio :: Int +clockRatio = fromIntegral $ snatToNatural (clockPeriod @ClocksSlow) `div` + snatToNatural (clockPeriod @System) + +unlockedLen :: Int +unlockedLen = snatToNum resetLen * clockRatio - clockRatio + 1 + +tests :: TestTree +tests = + testGroup "Clocks class" + [ testCase "Lock is resampled from reset" lockResampled ] diff --git a/clash-prelude/tests/unittests.hs b/clash-prelude/tests/unittests.hs index e836fb9a75..b949b5fcef 100644 --- a/clash-prelude/tests/unittests.hs +++ b/clash-prelude/tests/unittests.hs @@ -8,6 +8,7 @@ import qualified Clash.Tests.BitPack import qualified Clash.Tests.BitVector import qualified Clash.Tests.BlockRam import qualified Clash.Tests.BlockRam.Blob +import qualified Clash.Tests.Clocks import qualified Clash.Tests.Counter import qualified Clash.Tests.DerivingDataRepr import qualified Clash.Tests.Fixed @@ -34,6 +35,7 @@ tests = testGroup "Unittests" , Clash.Tests.BitVector.tests , Clash.Tests.BlockRam.tests , Clash.Tests.BlockRam.Blob.tests + , Clash.Tests.Clocks.tests , Clash.Tests.Counter.tests , Clash.Tests.DerivingDataRepr.tests , Clash.Tests.Fixed.tests