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 $ varToString bndr
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 "'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 (CoreSyn.Let (CoreSyn.Rec binds) (Var res)) <- normalizeExpr ("test input #" ++ show cycl) expr
133 (stimulansbindss, useds) <- unzipM $ Monad.mapM mkConcSm binds
134 sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds)
135 let sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)
136 let block_label = mkVHDLExtId ("testcycle_" ++ (show cycl))
137 let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (concat stimulansbindss)
138 return (AST.CSBSm block, res, concat useds)
140 -- | generates a clock process with a period of 10ns
141 createClkProc :: AST.ProcSm
142 createClkProc = AST.ProcSm (AST.unsafeVHDLBasicId "clkproc") [] sms
143 where sms = -- wait for 5 ns -- (half a cycle)
144 [AST.WaitFor $ AST.PrimLit "5 ns",
146 AST.NSimple clockId `AST.SigAssign`
147 AST.Wform [AST.WformElem (AST.Not (AST.PrimName $ AST.NSimple clockId)) Nothing]]
149 -- | generate the output process
150 createOutputProc :: [AST.VHDLId] -- ^ output signal
152 createOutputProc outs =
153 AST.ProcSm (AST.unsafeVHDLBasicId "writeoutput")
155 [AST.IfSm clkPred (writeOuts outs) [] Nothing]
156 where clkPred = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple clockId)
157 (AST.NSimple $ eventId)
159 (AST.PrimName (AST.NSimple clockId) AST.:=: AST.PrimLit "'1'")
160 writeOuts :: [AST.VHDLId] -> [AST.SeqSm]
162 writeOuts [i] = [writeOut i (AST.PrimLit "LF")]
163 writeOuts (i:is) = writeOut i (AST.PrimLit "HT") : writeOuts is
164 writeOut outSig suffix =
165 genExprPCall2 writeId
166 (AST.PrimName $ AST.NSimple outputId)
167 ((genExprFCall showId (AST.PrimName $ AST.NSimple outSig)) AST.:&: suffix)