2 -- Functions to create a VHDL testbench from a list of test input.
4 module CLasH.VHDL.Testbench where
7 import qualified Control.Monad as Monad
9 import qualified Data.Map as Map
11 import qualified Data.Accessor.MonadState as MonadState
14 import qualified Language.VHDL.AST as AST
18 import qualified HscTypes
20 import qualified TysWiredIn
23 import CLasH.Translator.TranslatorTypes
24 import CLasH.VHDL.Constants
25 import CLasH.VHDL.Generate
26 import CLasH.VHDL.VHDLTools
27 import CLasH.VHDL.VHDLTypes
28 import CLasH.Normalize
29 import CLasH.Utils.Core.BinderTools
30 import CLasH.Utils.Core.CoreTools
34 Maybe Int -- ^ Number of cycles to simulate
35 -> [HscTypes.CoreModule] -- ^ Compiled modules
36 -> CoreSyn.CoreExpr -- ^ Input stimuli
37 -> CoreSyn.CoreBndr -- ^ Top Entity
38 -> TranslatorSession CoreBndr -- ^ The id of the generated archictecture
39 createTestbench mCycles cores stimuli top = do
40 stimuli' <- reduceCoreListToHsList cores stimuli
41 -- Create a binder for the testbench. We use the unit type (), since the
42 -- testbench has no outputs and no inputs.
43 bndr <- mkInternalVar "testbench" TysWiredIn.unitTy
44 let entity = createTestbenchEntity bndr
45 modA tsEntities (Map.insert bndr entity)
46 arch <- createTestbenchArch mCycles stimuli' top entity
47 modA tsArchitectures (Map.insert bndr arch)
50 createTestbenchEntity ::
53 createTestbenchEntity bndr = entity
55 vhdl_id = mkVHDLBasicId "testbench"
56 -- Create an AST entity declaration with no ports
57 ent_decl = AST.EntityDec vhdl_id []
58 -- Create a signature with no input and no output ports
59 entity = Entity vhdl_id [] undefined ent_decl
61 createTestbenchArch ::
62 Maybe Int -- ^ Number of cycles to simulate
63 -> [CoreSyn.CoreExpr] -- ^ Imput stimuli
64 -> CoreSyn.CoreBndr -- ^ Top Entity
65 -> Entity -- ^ The signature to create an architecture for
66 -> TranslatorSession (Architecture, [CoreSyn.CoreBndr])
67 -- ^ The architecture and any other entities used.
68 createTestbenchArch mCycles stimuli top testent= do
69 signature <- getEntity top
70 let entId = ent_id signature
71 iIface = ent_args signature
72 oIface = ent_res signature
74 let (oId, oDec, oProc) = case oIface of
76 , [AST.SigDec id ty Nothing]
77 , [createOutputProc [id]])
78 -- No output port? Just use undefined for the output id, since it won't be
79 -- used by mkAssocElems when there is no output port.
80 Nothing -> (undefined, [], [])
81 let iDecs = map (\(vId, tm) -> AST.SigDec vId tm Nothing) iIface
82 let finalIDecs = iDecs ++
83 [AST.SigDec clockId std_logicTM (Just $ AST.PrimLit "'0'"),
84 AST.SigDec resetId std_logicTM (Just $ AST.PrimLit "'0'")]
85 let portmaps = mkAssocElems (map idToVHDLExpr iIds) (AST.NSimple oId) signature
86 let mIns = mkComponentInst "totest" entId portmaps
87 (stimuliAssigns, stimuliDecs, cycles, used) <- createStimuliAssigns mCycles stimuli (head iIds)
88 let finalAssigns = (AST.CSSASm (AST.NSimple resetId AST.:<==:
90 (AST.Wform [AST.WformElem (AST.PrimLit "'0'") (Just $ AST.PrimLit "0 ns"), AST.WformElem (AST.PrimLit "'1'") (Just $ AST.PrimLit "3 ns")])
91 Nothing)) : stimuliAssigns
92 let clkProc = createClkProc
93 let arch = AST.ArchBody
94 (AST.unsafeVHDLBasicId "test")
95 (AST.NSimple $ ent_id testent)
96 (map AST.BDISD (finalIDecs ++ stimuliDecs ++ oDec))
98 ( (AST.CSPSm clkProc) : (fmap AST.CSPSm oProc) ++ finalAssigns ) )
99 return (arch, top : used)
101 createStimuliAssigns ::
102 Maybe Int -- ^ Number of cycles to simulate
103 -> [CoreSyn.CoreExpr] -- ^ Input stimuli
104 -> AST.VHDLId -- ^ Input signal
105 -> TranslatorSession ( [AST.ConcSm]
108 , [CoreSyn.CoreBndr]) -- ^ (Resulting statements, Needed signals, The number of cycles to simulate, Any entities used)
109 createStimuliAssigns mCycles [] _ = return ([], [], Maybe.maybe 0 id mCycles, [])
111 createStimuliAssigns mCycles stimuli signal = do
112 let genWformElem time stim = (AST.WformElem stim (Just $ AST.PrimLit (show time ++ " ns")))
113 let inputlen = length stimuli
114 assigns <- Monad.zipWithM createStimulans stimuli [0..inputlen]
115 let (stimuli_sms, resvars, useds) = unzip3 assigns
116 sig_dec_maybes <- mapM mkSigDec resvars
117 let sig_decs = Maybe.catMaybes sig_dec_maybes
118 outps <- mapM (\x -> MonadState.lift tsType (varToVHDLExpr x)) resvars
119 let wformelems = zipWith genWformElem [0,10..] outps
120 let inassign = AST.CSSASm $ AST.NSimple signal AST.:<==: AST.ConWforms [] (AST.Wform wformelems) Nothing
121 return (stimuli_sms ++ [inassign], sig_decs, inputlen, concat useds)
124 CoreSyn.CoreExpr -- ^ The stimulans
125 -> Int -- ^ The cycle for this stimulans
126 -> TranslatorSession ( AST.ConcSm
128 , [CoreSyn.CoreBndr]) -- ^ (The statement, the variable it assigns to (assumed to be available!), Any entities used by this stimulans)
130 createStimulans expr cycl = do
131 -- There must be a let at top level
132 expr <- normalizeExpr ("test input #" ++ show cycl) expr
133 -- Split the normalized expression. It can't have a function type, so match
134 -- an empty list of argument binders
135 let ([], binds, res) = splitNormalized expr
136 (stimulansbindss, useds) <- unzipM $ Monad.mapM mkConcSm binds
137 sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds)
138 let sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)
139 let block_label = mkVHDLExtId ("testcycle_" ++ (show cycl))
140 let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (concat stimulansbindss)
141 return (AST.CSBSm block, res, concat useds)
143 -- | generates a clock process with a period of 10ns
144 createClkProc :: AST.ProcSm
145 createClkProc = AST.ProcSm (AST.unsafeVHDLBasicId "clkproc") [] sms
146 where sms = -- wait for 5 ns -- (half a cycle)
147 [AST.WaitFor $ AST.PrimLit "5 ns",
149 AST.NSimple clockId `AST.SigAssign`
150 AST.Wform [AST.WformElem (AST.Not (AST.PrimName $ AST.NSimple clockId)) Nothing]]
152 -- | generate the output process
153 createOutputProc :: [AST.VHDLId] -- ^ output signal
155 createOutputProc outs =
156 AST.ProcSm (AST.unsafeVHDLBasicId "writeoutput")
158 [AST.IfSm clkPred (writeOuts outs) [] Nothing]
159 where clkPred = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple clockId)
160 (AST.NSimple $ eventId)
162 (AST.PrimName (AST.NSimple clockId) AST.:=: AST.PrimLit "'1'")
163 writeOuts :: [AST.VHDLId] -> [AST.SeqSm]
165 writeOuts [i] = [writeOut i (AST.PrimLit "LF")]
166 writeOuts (i:is) = writeOut i (AST.PrimLit "HT") : writeOuts is
167 writeOut outSig suffix =
168 genExprPCall2 writeId
169 (AST.PrimName $ AST.NSimple outputId)
170 ((genExprFCall showId (AST.PrimName $ AST.NSimple outSig)) AST.:&: suffix)