Fix Clash.Clocks lock signal (#2417)

The lock signal is now `False` for the time that the input reset signal
is asserted, and `True` when the input reset signal is not asserted.

Before this commit, the lock signal output was defined in terms of the
reset input as follows:

```
rstIn :: Reset domIn
lockOut :: Signal pllOut Bool
lockOut = unsafeCoerce rstIn
```

This is incorrect in three ways:

* You can't coerce a `Reset` into a `Signal`, it segfaults.
* The timebase is wrong: one input sample becomes one output sample even
  when the output clock has a different period than the input clock.
* There is no handling of `ResetPolarity`; the simulation model is that
  lock is deasserted when reset is asserted.

(cherry picked from commit c60353e)

# Conflicts:
#	clash-prelude/src/Clash/Clocks/Deriving.hs

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`.

clash-prelude/clash-prelude.cabal

@@ -51,7 +51,7 @@ Maintainer:           QBayLogic B.V. <devops@qbaylogic.com>
 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

clash-prelude/src/Clash/Clocks/Deriving.hs

@@ -1,8 +1,14 @@
 {-|
+<<<<<<< HEAD
 Copyright  :  (C) 2018, Google Inc
                   2019, Myrtle Software Ltd
+=======
+Copyright  :  (C) 2018-2022, Google Inc
+                  2019,      Myrtle Software Ltd
+                  2023,      QBayLogic B.V.
+>>>>>>> c60353ef2 (Fix `Clash.Clocks` lock signal (#2417))
 License    :  BSD2 (see the file LICENSE)
-Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>
+Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>
 -}
 
 {-# LANGUAGE CPP #-}
@@ -12,6 +18,7 @@ Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>
 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
@@ -26,24 +33,48 @@ 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'
   let clk = mkName "clk"
   let rst = mkName "rst"
 
   -- Implementation of 'clocks'
+<<<<<<< HEAD
   let noInline  = PragmaD $ InlineP (mkName "clocks") NoInline FunLike AllPhases
   let clkImpls  = replicate n (clkImpl clk)
   let instTuple = mkTupE $ clkImpls ++ [AppE (VarE 'unsafeCoerce) (VarE rst)]
   let funcBody  = NormalB instTuple
   let instFunc  = FunD (mkName "clocks") [Clause [VarP clk, VarP rst] funcBody []]
+=======
+  lockImpl <- [| unsafeSynchronizer clockGen clockGen
+                   (unsafeToLowPolarity $(varE rst)) |]
+  let
+    noInline  = PragmaD $ InlineP (mkName "clocks") NoInline FunLike AllPhases
+    clkImpls  = replicate n (clkImpl clk)
+    instTuple = mkTupE $ clkImpls ++ [lockImpl]
+    funcBody  = NormalB instTuple
+    errMsg    = "clocks: dynamic clocks unsupported"
+    errBody   = NormalB ((VarE 'error) `AppE` (LitE (StringL errMsg)))
+    instFunc  = FunD (mkName "clocks")
+      [ Clause
+          [ AsP
+              clk
+              (conPatternNoTypes 'Clock [WildP, conPatternNoTypes 'Nothing []])
+          , VarP rst]
+          funcBody
+          []
+      , Clause [WildP, WildP] errBody []
+      ]
+>>>>>>> c60353ef2 (Fix `Clash.Clocks` lock signal (#2417))
 
   return $ InstanceD Nothing [] instHead [cxtTy, instFunc, noInline]
 
@@ -62,6 +93,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

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 ]

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