Skip to content

Commit

Permalink
Fix Xilinx clock wizard, add Tcl IP generation
Browse files Browse the repository at this point in the history
  • Loading branch information
hiddemoll committed Mar 17, 2023
1 parent 3bf1246 commit dfe248b
Show file tree
Hide file tree
Showing 10 changed files with 316 additions and 114 deletions.
3 changes: 3 additions & 0 deletions changelog/2023-03-01T12_18_28+01_00_xilinx_clocking_wizard
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
CHANGED: Remove `Asynchronous` constraint from Xilinx `clockWizard` and `clockWizardDifferential`. Originally intended to signal that these functions react synchronously to the incoming reset and that the outgoing lock signal is an asynchronous signal. Since synchronous reset signals are a subset of asynchronous reset signals this constraint on the input is vacuous. The constraint on the lock output does not convey this information at all and is wrong. Note that it is still necessary to synchronize the lock output in your design.
FIXED: Fix Xilinx ClockGen primitives. The port names of the Xilinx ClockGen primitives are now lowercase. The type of the lock output of Xilinx `clockWizard` and `clockWizardDifferential` is now `Signal Bool` instead of `Enable`, which was not the correct type here as a circuit should be kept in reset while the clock is stabilizing. This also fixes a polarity mismatch between hardware (and HDL simulation) and Haskell simulation. The lock signal is now also correctly resampled to the output domain.
ADD: Add Tcl generation of Xilinx `clockWizard` and `clockWizardDifferential`. This moves the responsibility of MMCM component generation from the user to `clashConnector.tcl`.
1 change: 1 addition & 0 deletions clash-lib/clash-lib.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -279,6 +279,7 @@ Library
Clash.Primitives.Sized.Signed
Clash.Primitives.Sized.Vector
Clash.Primitives.Verification
Clash.Primitives.Xilinx.ClockGen

Clash.Rewrite.Combinators
Clash.Rewrite.Types
Expand Down
54 changes: 32 additions & 22 deletions clash-lib/prims/commonverilog/Clash_Xilinx_ClockGen.primitives.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -3,40 +3,50 @@
kind: Declaration
type: |-
clockWizard
:: ( KnownDomain domIn confIn -- ARG[0]
, KnownDomain domOut confOut ) -- ARG[1]
=> SSymbol name -- ARG[2]
-> Clock pllIn -- ARG[3]
-> Reset pllIn -- ARG[4]
-> (Clock pllOut, Enable pllOut)
:: ( KnownDomain domIn -- ARG[0]
, KnownDomain domOut ) -- ARG[1]
=> SSymbol name -- ARG[2]
-> Clock domIn -- ARG[3]
-> Reset domIn -- ARG[4]
-> (Clock domOut, Signal domOut Bool)
template: |-
// clockWizard begin
~NAME[2] ~GENSYM[clockWizard_inst][2]
(.CLK_IN1 (~ARG[3])
,.RESET (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI ~ARG[4])
,.CLK_OUT1 (~RESULT[1])
,.LOCKED (~RESULT[0]));
(.clk_in1 (~ARG[3])
,.reset (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI ~ARG[4])
,.clk_out1 (~RESULT[1])
,.locked (~RESULT[0]));
// clockWizard end
includes:
- name: clk_wiz
extension: clash.tcl
format: Haskell
templateFunction: Clash.Primitives.Xilinx.ClockGen.clockWizardTclTF
workInfo: Always
- BlackBox:
name: Clash.Xilinx.ClockGen.clockWizardDifferential
kind: Declaration
type: |-
clockWizardDifferential
:: ( KnownDomain domIn confIn -- ARG[0]
, KnownDomain domOut confOut ) -- ARG[1]
:: SSymbol name -- ARG[2]
-> Clock pllIn -- ARG[3]
-> Clock pllIn -- ARG[4]
-> Reset pllIn -- ARG[5]
-> (Clock pllOut, Enable pllOut)
:: ( KnownDomain domIn -- ARG[0]
, KnownDomain domOut ) -- ARG[1]
:: SSymbol name -- ARG[2]
-> Clock domIn -- ARG[3]
-> Clock domIn -- ARG[4]
-> Reset domIn -- ARG[5]
-> (Clock domOut, Signal domOut Bool)
template: |-
// clockWizardDifferential begin
~NAME[2] ~GENSYM[clockWizardDifferential_inst][2]
(.CLK_IN1_D_clk_n (~ARG[3])
,.CLK_IN1_D_clk_n (~ARG[4])
,.RESET (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI ~ARG[5])
,.CLK_OUT1 (~RESULT[1])
,.LOCKED (~RESULT[0]));
(.clk_in1_n (~ARG[3])
,.clk_in1_p (~ARG[4])
,.reset (~IF ~ISACTIVEHIGH[0] ~THEN ~ELSE ! ~FI ~ARG[5])
,.clk_out1 (~RESULT[1])
,.locked (~RESULT[0]));
// clockWizardDifferential end
includes:
- name: clk_wiz
extension: clash.tcl
format: Haskell
templateFunction: Clash.Primitives.Xilinx.ClockGen.clockWizardDifferentialTclTF
workInfo: Always
73 changes: 46 additions & 27 deletions clash-lib/prims/vhdl/Clash_Xilinx_ClockGen.primitives.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -3,12 +3,12 @@
kind: Declaration
type: |-
clockWizard
:: ( KnownDomain domIn confIn -- ARG[0]
, KnownDomain domOut confOut ) -- ARG[1]
=> SSymbol name -- ARG[2]
-> Clock pllIn -- ARG[3]
-> Reset pllIn -- ARG[4]
-> (Clock pllOut, Enable pllOut)
:: ( KnownDomain domIn -- ARG[0]
, KnownDomain domOut ) -- ARG[1]
=> SSymbol name -- ARG[2]
-> Clock domIn -- ARG[3]
-> Reset domIn -- ARG[4]
-> (Clock domIn, Signal domOut Bool)
template: |-
-- clockWizard begin
~GENSYM[clockWizard][0] : block
Expand All @@ -17,49 +17,68 @@
signal ~GENSYM[pllLock][3] : boolean;
component ~NAME[2]
port (CLK_IN1 : in std_logic;
RESET : in std_logic;
CLK_OUT1 : out std_logic;
LOCKED : out std_logic);
port (clk_in1 : in std_logic;
reset : in std_logic;
clk_out1 : out std_logic;
locked : out std_logic);
end component;
begin
~GENSYM[clockWizard_inst][4] : component ~NAME[2] port map (~ARG[3],~IF ~ISACTIVEHIGH[0] ~THEN ~ARG[4] ~ELSE NOT(~ARG[4]) ~FI,~SYM[1],~SYM[2]);
~GENSYM[clockWizard_inst][4] : component ~NAME[3] port map (~ARG[4],~IF ~ISACTIVEHIGH[0] ~THEN ~ARG[5] ~ELSE NOT(~ARG[5]) ~FI,~SYM[1],~SYM[2]);
~SYM[3] <= true when ~SYM[2] = '1' else false;
~RESULT <= (~SYM[1],~SYM[3]);
end block;
-- clockWizard end
includes:
- name: clk_wiz
extension: clash.tcl
format: Haskell
templateFunction: Clash.Primitives.Xilinx.ClockGen.clockWizardTclTF
includes:
- name: clk_wiz
extension: clash.tcl
format: Haskell
templateFunction: Clash.Primitives.Xilinx.ClockGen.clockWizardTclTF
workInfo: Always
- BlackBox:
name: Clash.Xilinx.ClockGen.clockWizardDifferential
kind: Declaration
type: |-
clockWizardDifferential
:: ( KnownDomain domIn confIn -- ARG[0]
, KnownDomain domOut confOut ) -- ARG[1]
=> SSymbol name -- ARG[2]
-> Clock pllIn -- ARG[3]
-> Clock pllIn -- ARG[4]
-> Reset pllIn -- ARG[5]
-> (Clock pllOut, Enable pllOut)
clockWizard
:: ( KnownDomain domIn -- ARG[0]
, KnownDomain domOut ) -- ARG[1]
=> SSymbol name -- ARG[2]
-> Clock domIn -- ARG[3]
-> Clock domIn -- ARG[4]
-> Reset domIn -- ARG[5]
-> (Clock domOut, Signal domOut Bool)
template: |-
-- clockWizardDifferential begin
~GENSYM[clockWizardDifferential][0] : block
signal ~GENSYM[pllOut][1] : std_logic;
signal ~GENSYM[locked][2] : std_logic;
signal ~GENSYM[pllLock][3] : boolean;
component ~NAME[2]
port (CLK_IN1_D_clk_n : in std_logic;
CLK_IN1_D_clk_p : in std_logic;
RESET : in std_logic;
CLK_OUT1 : out std_logic;
LOCKED : out std_logic);
port (clk_in1_n : in std_logic;
clk_in1_p : in std_logic;
reset : in std_logic;
clk_out1 : out std_logic;
locked : out std_logic);
end component;
begin
~GENSYM[clockWizardDifferential_inst][4] : component ~NAME[2]
port map (~ARG[3],~ARG[4],~IF ~ISACTIVEHIGH[0] ~THEN ~ARG[5] ~ELSE NOT(~ARG[5]) ~FI,~SYM[1],~SYM[2]);
~GENSYM[clockWizardDifferential_inst][4] : component ~NAME[3]
port map (~ARG[4],~ARG[5],~IF ~ISACTIVEHIGH[0] ~THEN ~ARG[6] ~ELSE NOT(~ARG[6]) ~FI,~SYM[1],~SYM[2]);
~SYM[3] <= true when ~SYM[2] = '1' else false;
~RESULT <= (~SYM[1],~SYM[3]);
end block;
-- clockWizardDifferential end
includes:
- name: clk_wiz
extension: clash.tcl
format: Haskell
templateFunction: Clash.Primitives.Xilinx.ClockGen.clockWizardDifferentialTclTF
includes:
- name: clk_wiz
extension: clash.tcl
format: Haskell
templateFunction: Clash.Primitives.Xilinx.ClockGen.clockWizardDifferentialTclTF
workInfo: Always
3 changes: 3 additions & 0 deletions clash-lib/src/Clash/Driver.hs
Original file line number Diff line number Diff line change
Expand Up @@ -141,6 +141,7 @@ import qualified Clash.Primitives.GHC.Word as P
import qualified Clash.Primitives.Intel.ClockGen as P
import qualified Clash.Primitives.Prelude as P
import qualified Clash.Primitives.Verification as P
import qualified Clash.Primitives.Xilinx.ClockGen as P
import Clash.Primitives.Types
import Clash.Signal.Internal
import Clash.Unique (Unique, getUnique)
Expand Down Expand Up @@ -602,6 +603,8 @@ knownTemplateFunctions =
, ('P.alteraPllTF, P.alteraPllTF)
, ('P.altpllTF, P.altpllTF)
, ('P.fromIntegerTFvhdl, P.fromIntegerTFvhdl)
, ('P.clockWizardTclTF, P.clockWizardTclTF)
, ('P.clockWizardDifferentialTclTF, P.clockWizardDifferentialTclTF)
]

-- | Compiles blackbox functions and parses blackbox templates.
Expand Down
100 changes: 100 additions & 0 deletions clash-lib/src/Clash/Primitives/Xilinx/ClockGen.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,100 @@
{-|
Copyright : (C) 2023, QBayLogic B.V.
License : BSD2 (see the file LICENSE)
Maintainer : QBayLogic B.V. <devops@qbaylogic.com>
Blackbox template functions for
Clash.Xilinx.ClockGen.{clockWizard,clockWizardDifferential}
-}

{-# LANGUAGE QuasiQuotes #-}

module Clash.Primitives.Xilinx.ClockGen where

import Control.Monad.State (State)
import qualified Data.String.Interpolate as I

import Clash.Signal (periodToHz)

import Clash.Backend (Backend)
import Clash.Netlist.BlackBox.Util (exprToString)
import Clash.Netlist.Types
import Clash.Netlist.Util (stripVoid)
import Data.Text.Prettyprint.Doc.Extra (Doc)


clockWizardTclTF :: TemplateFunction
clockWizardTclTF =
TemplateFunction used valid (clockWizardTclTemplate False)
where
knownDomIn = 0
knownDomOut = 1
name = 2
-- clk = 3
-- rst = 4
used = [knownDomIn, knownDomOut, name]
valid = const True

clockWizardDifferentialTclTF :: TemplateFunction
clockWizardDifferentialTclTF =
TemplateFunction used valid (clockWizardTclTemplate True)
where
knownDomIn = 0
knownDomOut = 1
name = 2
-- clkN = 3
-- clkP = 4
-- rst = 5
used = [knownDomIn, knownDomOut, name]
valid = const True


clockWizardTclTemplate
:: Backend s
=> Bool
-> BlackBoxContext
-> State s Doc
clockWizardTclTemplate isDifferential bbCtx
| (_,stripVoid -> (KnownDomain _ clkInPeriod _ _ _ _),_) <- bbInputs bbCtx !! 0
, (_,stripVoid -> (KnownDomain _ clkOutPeriod _ _ _ _),_) <- bbInputs bbCtx !! 1
, (nm,_,_) <- bbInputs bbCtx !! 2
, [(Identifier _ Nothing,Product {})] <- bbResults bbCtx
, Just compName <- exprToString nm
=
let
clkInFreq :: Double
clkInFreq = periodToHz (fromInteger clkInPeriod) / 1e6
clkOutFreq :: Double
clkOutFreq = periodToHz (fromInteger clkOutPeriod) / 1e6

differentialPinString = if isDifferential
then "Differential_clock_capable_pin"
else "Single_ended_clock_capable_pin"

bbText = [I.__i|
namespace eval $tclIface {
variable api 1
variable scriptPurpose createIp
variable ipName {#{compName}}

proc createIp {ipName0 args} {
create_ip \\
-name clk_wiz \\
-vendor xilinx.com \\
-library ip \\
-version 6.0 \\
-module_name $ipName0 \\
{*}$args

set_property \\
-dict [list \\
CONFIG.PRIM_SOURCE #{differentialPinString} \\
CONFIG.PRIM_IN_FREQ #{clkInFreq} \\
CONFIG.CLKOUT1_REQUESTED_OUT_FREQ #{clkOutFreq} \\
] [get_ips $ipName0]
return
}
}|]
in pure bbText
| otherwise
= error ("clockWizardTclTemplate: bad bbContext: " <> show bbCtx)
12 changes: 4 additions & 8 deletions clash-prelude/src/Clash/Clocks/Deriving.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,12 +13,12 @@ Maintainer : QBayLogic B.V. <devops@qbaylogic.com>
module Clash.Clocks.Deriving (deriveClocksInstances) where

import Control.Monad (foldM)
import Clash.Promoted.Symbol (SSymbol(..))
import Clash.Explicit.Signal (unsafeSynchronizer)
import Clash.Signal.Internal
import Language.Haskell.TH.Compat
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Lib
import Unsafe.Coerce (unsafeCoerce)

conPatternNoTypes :: Name -> [Pat] -> Pat
#if MIN_VERSION_template_haskell(2,18,0)
Expand Down Expand Up @@ -46,24 +46,22 @@ derive' n = do
#endif

-- Function definition of 'clocks'
let clk = mkName "clk"
let rst = mkName "rst"

-- Implementation of 'clocks'
clkImpl <- [| Clock SSymbol Nothing |]
lockImpl <- [| unsafeSynchronizer clockGen clockGen
(unsafeToLowPolarity $(varE rst)) |]
let
noInline = PragmaD $ InlineP (mkName "clocks") NoInline FunLike AllPhases
clkImpls = replicate n (clkImpl clk)
clkImpls = replicate n clkImpl
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 []])
[ (conPatternNoTypes 'Clock [WildP, conPatternNoTypes 'Nothing []])
, VarP rst]
funcBody
[]
Expand Down Expand Up @@ -92,8 +90,6 @@ derive' n = do
[t| KnownDomain $p |]


clkImpl clk = AppE (VarE 'unsafeCoerce) (VarE clk)

-- Derive instances for up to and including to /n/ clocks
deriveClocksInstances :: Int -> Q [Dec]
deriveClocksInstances n = mapM derive' [1..n]

0 comments on commit dfe248b

Please sign in to comment.