{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ViewPatterns #-}
module Clash.Primitives.Intel.ClockGen where
import Clash.Backend
import Clash.Netlist.BlackBox.Util
import Clash.Netlist.Id
import Clash.Netlist.Types
import Clash.Netlist.Util hiding (mkUniqueIdentifier)
import Control.Monad.State
import Data.Semigroup.Monad
import qualified Data.String.Interpolate.IsString as I
import Data.Text.Prettyprint.Doc.Extra
import qualified Data.Text as TextS
altpllTF :: TemplateFunction
altpllTF :: TemplateFunction
altpllTF = [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
used BlackBoxContext -> Bool
valid forall s. Backend s => BlackBoxContext -> State s Doc
altpllTemplate
where
used :: [Int]
used = [0..4]
valid :: BlackBoxContext -> Bool
valid bbCtx :: BlackBoxContext
bbCtx
| [_,_,(nm :: Expr
nm,_,_),_,_] <- BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx
, Just _ <- Expr -> Maybe String
exprToString Expr
nm
, (Identifier _ Nothing,Product {}) <- BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx
= Bool
True
valid _ = Bool
False
altpllQsysTF :: TemplateFunction
altpllQsysTF :: TemplateFunction
altpllQsysTF = [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
used BlackBoxContext -> Bool
valid forall s. Backend s => BlackBoxContext -> State s Doc
altpllQsysTemplate
where
used :: [Int]
used = [0..4]
valid :: BlackBoxContext -> Bool
valid bbCtx :: BlackBoxContext
bbCtx
| [_,_,(nm :: Expr
nm,_,_),_,_] <- BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx
, Just _ <- Expr -> Maybe String
exprToString Expr
nm
, (Identifier _ Nothing,Product {}) <- BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx
= Bool
True
valid _ = Bool
False
alteraPllTF :: TemplateFunction
alteraPllTF :: TemplateFunction
alteraPllTF = [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
used BlackBoxContext -> Bool
valid forall s. Backend s => BlackBoxContext -> State s Doc
alteraPllTemplate
where
used :: [Int]
used = [1..20]
valid :: BlackBoxContext -> Bool
valid bbCtx :: BlackBoxContext
bbCtx
| ((nm :: Expr
nm,_,_):_) <- Int -> [(Expr, HWType, Bool)] -> [(Expr, HWType, Bool)]
forall a. Int -> [a] -> [a]
drop 3 (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx)
, Just _ <- Expr -> Maybe String
exprToString Expr
nm
= Bool
True
valid _ = Bool
False
alteraPllQsysTF :: TemplateFunction
alteraPllQsysTF :: TemplateFunction
alteraPllQsysTF = [Int]
-> (BlackBoxContext -> Bool)
-> (forall s. Backend s => BlackBoxContext -> State s Doc)
-> TemplateFunction
TemplateFunction [Int]
used BlackBoxContext -> Bool
valid forall s. Backend s => BlackBoxContext -> State s Doc
alteraPllQsysTemplate
where
used :: [Int]
used = [1..20]
valid :: BlackBoxContext -> Bool
valid bbCtx :: BlackBoxContext
bbCtx
| ((nm :: Expr
nm,_,_):_) <- Int -> [(Expr, HWType, Bool)] -> [(Expr, HWType, Bool)]
forall a. Int -> [a] -> [a]
drop 3 (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx)
, Just _ <- Expr -> Maybe String
exprToString Expr
nm
= Bool
True
valid _ = Bool
False
alteraPllTemplate
:: Backend s
=> BlackBoxContext
-> State s Doc
alteraPllTemplate :: BlackBoxContext -> State s Doc
alteraPllTemplate bbCtx :: BlackBoxContext
bbCtx = do
let mkId :: Identifier -> State s Identifier
mkId = IdType -> Identifier -> State s Identifier
forall s. Backend s => IdType -> Identifier -> State s Identifier
mkUniqueIdentifier IdType
Basic
Identifier
locked <- Identifier -> State s Identifier
mkId "locked"
Identifier
pllLock <- Identifier -> State s Identifier
mkId "pllLock"
Identifier
alteraPll <- Identifier -> State s Identifier
mkId "altera_pll_block"
Identifier
alteraPll_inst <- Identifier -> State s Identifier
mkId Identifier
instname0
[Identifier]
clocks <- (Identifier -> State s Identifier)
-> [Identifier] -> StateT s Identity [Identifier]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (IdType -> Identifier -> State s Identifier
forall s. Backend s => IdType -> Identifier -> State s Identifier
mkUniqueIdentifier IdType
Extended)
[String -> Identifier
TextS.pack ("pllOut" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) | Int
n <- [0..[HWType] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [HWType]
tys Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1]]
Mon (State s) Doc -> State s Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Mon (State s) Doc -> State s Doc)
-> Mon (State s) Doc -> State s Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> [Declaration] -> Mon (State s) Doc
forall state.
Backend state =>
Identifier -> [Declaration] -> Mon (State state) Doc
blockDecl Identifier
alteraPll ([Declaration] -> Mon (State s) Doc)
-> [Declaration] -> Mon (State s) Doc
forall a b. (a -> b) -> a -> b
$ [[Declaration]] -> [Declaration]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat
[[ Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
locked HWType
rstTy
, Maybe Identifier
-> WireOrReg
-> Identifier
-> Either Identifier HWType
-> Maybe Expr
-> Declaration
NetDecl' Maybe Identifier
forall a. Maybe a
Nothing WireOrReg
Reg Identifier
pllLock (HWType -> Either Identifier HWType
forall a b. b -> Either a b
Right HWType
Bool) Maybe Expr
forall a. Maybe a
Nothing]
,[ Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
clkNm HWType
ty | (clkNm :: Identifier
clkNm,ty :: HWType
ty) <- [Identifier] -> [HWType] -> [(Identifier, HWType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Identifier]
clocks [HWType]
tys]
,[ EntityOrComponent
-> Maybe Identifier
-> Identifier
-> Identifier
-> [(Expr, HWType, Expr)]
-> [(Expr, PortDirection, HWType, Expr)]
-> Declaration
InstDecl EntityOrComponent
Comp Maybe Identifier
forall a. Maybe a
Nothing Identifier
compName Identifier
alteraPll_inst [] ([(Expr, PortDirection, HWType, Expr)] -> Declaration)
-> [(Expr, PortDirection, HWType, Expr)] -> Declaration
forall a b. (a -> b) -> a -> b
$ [[(Expr, PortDirection, HWType, Expr)]]
-> [(Expr, PortDirection, HWType, Expr)]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat
[[(Identifier -> Maybe Modifier -> Expr
Identifier "refclk" Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
In,HWType
clkTy,Expr
clk)
,(Identifier -> Maybe Modifier -> Expr
Identifier "rst" Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
In,HWType
rstTy,Expr
rst)]
,[(Identifier -> Maybe Modifier -> Expr
Identifier (String -> Identifier
TextS.pack ("outclk_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)) Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
Out,HWType
ty,Identifier -> Maybe Modifier -> Expr
Identifier Identifier
k Maybe Modifier
forall a. Maybe a
Nothing)
|(k :: Identifier
k,ty :: HWType
ty,n :: Int
n) <- [Identifier] -> [HWType] -> [Int] -> [(Identifier, HWType, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Identifier]
clocks [HWType]
tys [(0 :: Int)..] ]
,[(Identifier -> Maybe Modifier -> Expr
Identifier "locked" Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
Out,HWType
rstTy,Identifier -> Maybe Modifier -> Expr
Identifier Identifier
locked Maybe Modifier
forall a. Maybe a
Nothing)]]
, Identifier
-> HWType
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Declaration
CondAssignment Identifier
pllLock HWType
Bool (Identifier -> Maybe Modifier -> Expr
Identifier Identifier
locked Maybe Modifier
forall a. Maybe a
Nothing) HWType
rstTy
[(Literal -> Maybe Literal
forall a. a -> Maybe a
Just (Bit -> Literal
BitLit Bit
H),Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing (Bool -> Literal
BoolLit Bool
True))
,(Maybe Literal
forall a. Maybe a
Nothing ,Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing (Bool -> Literal
BoolLit Bool
False))]
, Identifier -> Expr -> Declaration
Assignment Identifier
result (HWType -> Modifier -> [Expr] -> Expr
DataCon HWType
resTy ((HWType, Int) -> Modifier
DC (HWType
resTy,0)) ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ [[Expr]] -> [Expr]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat
[[Identifier -> Maybe Modifier -> Expr
Identifier Identifier
k Maybe Modifier
forall a. Maybe a
Nothing | Identifier
k <- [Identifier]
clocks]
,[Identifier -> Maybe Modifier -> Expr
Identifier Identifier
pllLock Maybe Modifier
forall a. Maybe a
Nothing]])
]
]
where
(Identifier result :: Identifier
result Nothing,resTy :: HWType
resTy@(Product _ _ ([HWType] -> [HWType]
forall a. [a] -> [a]
init -> [HWType]
tys))) = BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx
[(nm :: Expr
nm,_,_),(clk :: Expr
clk,clkTy :: HWType
clkTy,_),(rst :: Expr
rst,rstTy :: HWType
rstTy,_)] = Int -> [(Expr, HWType, Bool)] -> [(Expr, HWType, Bool)]
forall a. Int -> [a] -> [a]
drop 3 (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx)
Just nm' :: String
nm' = Expr -> Maybe String
exprToString Expr
nm
instname0 :: Identifier
instname0 = String -> Identifier
TextS.pack String
nm'
compName :: Identifier
compName = [Identifier] -> Identifier
forall a. [a] -> a
head (BlackBoxContext -> [Identifier]
bbQsysIncName BlackBoxContext
bbCtx)
altpllTemplate
:: Backend s
=> BlackBoxContext
-> State s Doc
altpllTemplate :: BlackBoxContext -> State s Doc
altpllTemplate bbCtx :: BlackBoxContext
bbCtx = do
let mkId :: Identifier -> State s Identifier
mkId = IdType -> Identifier -> State s Identifier
forall s. Backend s => IdType -> Identifier -> State s Identifier
mkUniqueIdentifier IdType
Basic
Identifier
pllOut <- Identifier -> State s Identifier
mkId "pllOut"
Identifier
locked <- Identifier -> State s Identifier
mkId "locked"
Identifier
pllLock <- Identifier -> State s Identifier
mkId "pllLock"
Identifier
alteraPll <- Identifier -> State s Identifier
mkId "altpll_block"
Identifier
alteraPll_inst <- Identifier -> State s Identifier
mkId Identifier
instname0
Mon (State s) Doc -> State s Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Mon (State s) Doc -> State s Doc)
-> Mon (State s) Doc -> State s Doc
forall a b. (a -> b) -> a -> b
$ Identifier -> [Declaration] -> Mon (State s) Doc
forall state.
Backend state =>
Identifier -> [Declaration] -> Mon (State state) Doc
blockDecl Identifier
alteraPll
[ Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
locked HWType
Bit
, Maybe Identifier
-> WireOrReg
-> Identifier
-> Either Identifier HWType
-> Maybe Expr
-> Declaration
NetDecl' Maybe Identifier
forall a. Maybe a
Nothing WireOrReg
Reg Identifier
pllLock (HWType -> Either Identifier HWType
forall a b. b -> Either a b
Right HWType
Bool) Maybe Expr
forall a. Maybe a
Nothing
, Maybe Identifier -> Identifier -> HWType -> Declaration
NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
pllOut HWType
clkOutTy
, EntityOrComponent
-> Maybe Identifier
-> Identifier
-> Identifier
-> [(Expr, HWType, Expr)]
-> [(Expr, PortDirection, HWType, Expr)]
-> Declaration
InstDecl EntityOrComponent
Comp Maybe Identifier
forall a. Maybe a
Nothing Identifier
compName Identifier
alteraPll_inst []
[(Identifier -> Maybe Modifier -> Expr
Identifier "clk" Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
In,HWType
clkTy,Expr
clk)
,(Identifier -> Maybe Modifier -> Expr
Identifier "areset" Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
In,HWType
rstTy,Expr
rst)
,(Identifier -> Maybe Modifier -> Expr
Identifier "c0" Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
Out,HWType
clkOutTy,Identifier -> Maybe Modifier -> Expr
Identifier Identifier
pllOut Maybe Modifier
forall a. Maybe a
Nothing)
,(Identifier -> Maybe Modifier -> Expr
Identifier "locked" Maybe Modifier
forall a. Maybe a
Nothing,PortDirection
Out,HWType
Bit,Identifier -> Maybe Modifier -> Expr
Identifier Identifier
locked Maybe Modifier
forall a. Maybe a
Nothing)]
, Identifier
-> HWType
-> Expr
-> HWType
-> [(Maybe Literal, Expr)]
-> Declaration
CondAssignment Identifier
pllLock HWType
Bool (Identifier -> Maybe Modifier -> Expr
Identifier Identifier
locked Maybe Modifier
forall a. Maybe a
Nothing) HWType
rstTy
[(Literal -> Maybe Literal
forall a. a -> Maybe a
Just (Bit -> Literal
BitLit Bit
H),Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing (Bool -> Literal
BoolLit Bool
True))
,(Maybe Literal
forall a. Maybe a
Nothing ,Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing (Bool -> Literal
BoolLit Bool
False))]
, Identifier -> Expr -> Declaration
Assignment Identifier
result (HWType -> Modifier -> [Expr] -> Expr
DataCon HWType
resTy ((HWType, Int) -> Modifier
DC (HWType
resTy,0))
[Identifier -> Maybe Modifier -> Expr
Identifier Identifier
pllOut Maybe Modifier
forall a. Maybe a
Nothing
,Identifier -> Maybe Modifier -> Expr
Identifier Identifier
pllLock Maybe Modifier
forall a. Maybe a
Nothing])
]
where
[_,_,(nm :: Expr
nm,_,_),(clk :: Expr
clk,clkTy :: HWType
clkTy,_),(rst :: Expr
rst,rstTy :: HWType
rstTy,_)] = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx
(Identifier result :: Identifier
result Nothing,resTy :: HWType
resTy@(Product _ _ [clkOutTy :: HWType
clkOutTy,_])) = BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx
Just nm' :: String
nm' = Expr -> Maybe String
exprToString Expr
nm
instname0 :: Identifier
instname0 = String -> Identifier
TextS.pack String
nm'
compName :: Identifier
compName = [Identifier] -> Identifier
forall a. [a] -> a
head (BlackBoxContext -> [Identifier]
bbQsysIncName BlackBoxContext
bbCtx)
altpllQsysTemplate
:: Backend s
=> BlackBoxContext
-> State s Doc
altpllQsysTemplate :: BlackBoxContext -> State s Doc
altpllQsysTemplate bbCtx :: BlackBoxContext
bbCtx = Doc -> State s Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
bbText
where
((_,HWType -> HWType
stripVoid -> HWType
kdIn,_):(_,HWType -> HWType
stripVoid -> HWType
kdOut,_):_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx
KnownDomain _ clkInPeriod :: Integer
clkInPeriod _ _ _ _ = HWType
kdIn
KnownDomain _ clkOutPeriod :: Integer
clkOutPeriod _ _ _ _ = HWType
kdOut
clkOutFreq :: Double
clkOutFreq :: Double
clkOutFreq = (1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
clkOutPeriod Double -> Double -> Double
forall a. Num a => a -> a -> a
* 1.0e-12)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 1e6
clklcm :: Integer
clklcm = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
lcm Integer
clkInPeriod Integer
clkOutPeriod
clkmult :: Integer
clkmult = Integer
clklcm Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
clkOutPeriod
clkdiv :: Integer
clkdiv = Integer
clklcm Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
clkInPeriod
bbText :: Doc
bbText = [I.i|<?xml version="1.0" encoding="UTF-8"?>
<system name="$${FILENAME}">
<module
name="altpll0"
kind="altpll"
enabled="1"
autoexport="1">
<parameter name="AVALON_USE_SEPARATE_SYSCLK" value="NO" />
<parameter name="BANDWIDTH" value="" />
<parameter name="BANDWIDTH_TYPE" value="AUTO" />
<parameter name="CLK0_DIVIDE_BY" value="#{clkdiv}" />
<parameter name="CLK0_DUTY_CYCLE" value="50" />
<parameter name="CLK0_MULTIPLY_BY" value="#{clkmult}" />
<parameter name="CLK0_PHASE_SHIFT" value="0" />
<parameter name="COMPENSATE_CLOCK" value="CLK0" />
<parameter name="INCLK0_INPUT_FREQUENCY" value="#{clkInPeriod}" />
<parameter name="OPERATION_MODE" value="NORMAL" />
<parameter name="PLL_TYPE" value="AUTO" />
<parameter name="PORT_ARESET" value="PORT_USED" />
<parameter name="PORT_INCLK0" value="PORT_USED" />
<parameter name="PORT_LOCKED" value="PORT_USED" />
<parameter name="PORT_clk0" value="PORT_USED" />
<parameter name="HIDDEN_IS_FIRST_EDIT" value="0" />
<parameter name="HIDDEN_PRIVATES">PT#EFF_OUTPUT_FREQ_VALUE0 #{clkOutFreq}</parameter>
</module>
</system>|]
alteraPllQsysTemplate
:: Backend s
=> BlackBoxContext
-> State s Doc
alteraPllQsysTemplate :: BlackBoxContext -> State s Doc
alteraPllQsysTemplate bbCtx :: BlackBoxContext
bbCtx = Doc -> State s Doc
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc
bbText
where
(_:(_,HWType -> HWType
stripVoid -> HWType
kdIn,_):(_,HWType -> HWType
stripVoid -> HWType
kdOutsProd,_):_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx
kdOuts :: [HWType]
kdOuts = case HWType
kdOutsProd of
Product _ _ ps :: [HWType]
ps -> [HWType]
ps
KnownDomain {} -> [HWType
kdOutsProd]
_ -> String -> [HWType]
forall a. HasCallStack => String -> a
error "internal error: not a Product or KnownDomain"
cklFreq :: HWType -> Double
cklFreq (KnownDomain _ p :: Integer
p _ _ _ _)
= (1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
p Double -> Double -> Double
forall a. Num a => a -> a -> a
* 1.0e-12 :: Double)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 1e6
cklFreq _ = String -> Double
forall a. HasCallStack => String -> a
error "internal error: not a KnownDomain"
clkOuts :: Identifier
clkOuts = [Identifier] -> Identifier
TextS.unlines
[[I.i|<parameter name="gui_output_clock_frequency#{n}" value="#{f}"/>|]
| (n :: Word
n,f :: Double
f) <- [Word] -> [Double] -> [(Word, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(0 :: Word)..] ((HWType -> Double) -> [HWType] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map HWType -> Double
cklFreq [HWType]
kdOuts)
]
bbText :: Doc
bbText = [I.i|<?xml version="1.0" encoding="UTF-8"?>
<system name="$${FILENAME}">
<module
name="pll_0"
kind="altera_pll"
enabled="1"
autoexport="1">
<parameter name="gui_feedback_clock" value="Global Clock" />
<parameter name="gui_number_of_clocks" value="#{length kdOuts}" />
<parameter name="gui_operation_mode" value="direct" />
#{clkOuts}
<parameter name="gui_pll_mode" value="Integer-N PLL" />
<parameter name="gui_reference_clock_frequency" value="#{cklFreq kdIn}" />
<parameter name="gui_use_locked" value="true" />
</module>
</system>|]