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
19 import qualified TysWiredIn
22 import CLasH.Translator.TranslatorTypes
23 import CLasH.VHDL.Constants
24 import CLasH.VHDL.Generate
25 import CLasH.VHDL.VHDLTools
26 import CLasH.VHDL.VHDLTypes
27 import CLasH.Normalize
28 import CLasH.Utils.Core.BinderTools
29 import CLasH.Utils.Core.CoreTools
33 Maybe Int -- ^ Number of cycles to simulate
34 -> CoreSyn.CoreExpr -- ^ Input stimuli
35 -> CoreSyn.CoreBndr -- ^ Top Entity
36 -> TranslatorSession CoreBndr -- ^ The id of the generated archictecture
37 createTestbench mCycles stimuli top = do
38 let stimuli' = reduceCoreListToHsList stimuli
39 -- Create a binder for the testbench. We use the unit type (), since the
40 -- testbench has no outputs and no inputs.
41 bndr <- mkInternalVar "testbench" TysWiredIn.unitTy
42 let entity = createTestbenchEntity bndr
43 modA tsEntities (Map.insert bndr entity)
44 arch <- createTestbenchArch mCycles stimuli' top entity
45 modA tsArchitectures (Map.insert bndr arch)
48 createTestbenchEntity ::
51 createTestbenchEntity bndr = entity
53 vhdl_id = mkVHDLBasicId $ varToString bndr
54 -- Create an AST entity declaration with no ports
55 ent_decl = AST.EntityDec vhdl_id []
56 -- Create a signature with no input and no output ports
57 entity = Entity vhdl_id [] undefined ent_decl
59 createTestbenchArch ::
60 Maybe Int -- ^ Number of cycles to simulate
61 -> [CoreSyn.CoreExpr] -- ^ Imput stimuli
62 -> CoreSyn.CoreBndr -- ^ Top Entity
63 -> Entity -- ^ The signature to create an architecture for
64 -> TranslatorSession (Architecture, [CoreSyn.CoreBndr])
65 -- ^ The architecture and any other entities used.
66 createTestbenchArch mCycles stimuli top testent= do
67 signature <- getEntity top
68 let entId = ent_id signature
69 iIface = ent_args signature
70 oIface = ent_res signature
73 let iDecs = map (\(vId, tm) -> AST.SigDec vId tm Nothing) iIface
74 let finalIDecs = iDecs ++
75 [AST.SigDec clockId std_logicTM (Just $ AST.PrimLit "'0'"),
76 AST.SigDec resetId std_logicTM (Just $ AST.PrimLit "'0'")]
77 let oDecs = AST.SigDec (fst oIface) (snd oIface) Nothing
78 let portmaps = mkAssocElems (map idToVHDLExpr iIds) (AST.NSimple oId) signature
79 let mIns = mkComponentInst "totest" entId portmaps
80 (stimuliAssigns, stimuliDecs, cycles, used) <- createStimuliAssigns mCycles stimuli (head iIds)
81 let finalAssigns = (AST.CSSASm (AST.NSimple resetId AST.:<==:
83 (AST.Wform [AST.WformElem (AST.PrimLit "'1'") (Just $ AST.PrimLit "3 ns")])
84 Nothing)) : stimuliAssigns
85 let clkProc = createClkProc
86 let outputProc = createOutputProc [oId]
87 let arch = AST.ArchBody
88 (AST.unsafeVHDLBasicId "test")
89 (AST.NSimple $ ent_id testent)
90 (map AST.BDISD (finalIDecs ++ stimuliDecs ++ [oDecs]))
92 ( (AST.CSPSm clkProc) : (AST.CSPSm outputProc) : finalAssigns ) )
93 return (arch, top : used)
95 createStimuliAssigns ::
96 Maybe Int -- ^ Number of cycles to simulate
97 -> [CoreSyn.CoreExpr] -- ^ Input stimuli
98 -> AST.VHDLId -- ^ Input signal
99 -> TranslatorSession ( [AST.ConcSm] -- ^ Resulting statemetns
100 , [AST.SigDec] -- ^ Needed signals
101 , Int -- ^ The number of cycles to simulate
102 , [CoreSyn.CoreBndr]) -- ^ Any entities used
103 createStimuliAssigns mCycles [] _ = return ([], [], Maybe.maybe 0 id mCycles, [])
105 createStimuliAssigns mCycles stimuli signal = do
106 let genWformElem time stim = (AST.WformElem stim (Just $ AST.PrimLit (show time ++ " ns")))
107 let inputlen = length stimuli
108 assigns <- Monad.zipWithM createStimulans stimuli [0..inputlen]
109 let (stimuli_sms, resvars, useds) = unzip3 assigns
110 sig_dec_maybes <- mapM mkSigDec resvars
111 let sig_decs = Maybe.catMaybes sig_dec_maybes
112 outps <- mapM (\x -> MonadState.lift tsType (varToVHDLExpr x)) resvars
113 let wformelems = zipWith genWformElem [0,10..] outps
114 let inassign = AST.CSSASm $ AST.NSimple signal AST.:<==: AST.ConWforms [] (AST.Wform wformelems) Nothing
115 return (stimuli_sms ++ [inassign], sig_decs, inputlen, concat useds)
118 CoreSyn.CoreExpr -- ^ The stimulans
119 -> Int -- ^ The cycle for this stimulans
120 -> TranslatorSession ( AST.ConcSm -- ^ The statement
121 , Var.Var -- ^ the variable it assigns to (assumed to be available!)
122 , [CoreSyn.CoreBndr]) -- ^ Any entities used by this stimulans
124 createStimulans expr cycl = do
125 -- There must be a let at top level
126 (CoreSyn.Let (CoreSyn.Rec binds) (Var res)) <- normalizeExpr ("test input #" ++ show cycl) expr
127 (stimulansbindss, useds) <- unzipM $ Monad.mapM mkConcSm binds
128 sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds)
129 let sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)
130 let block_label = mkVHDLExtId ("testcycle_" ++ (show cycl))
131 let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (concat stimulansbindss)
132 return (AST.CSBSm block, res, concat useds)
134 -- | generates a clock process with a period of 10ns
135 createClkProc :: AST.ProcSm
136 createClkProc = AST.ProcSm (AST.unsafeVHDLBasicId "clkproc") [] sms
137 where sms = -- wait for 5 ns -- (half a cycle)
138 [AST.WaitFor $ AST.PrimLit "5 ns",
140 AST.NSimple clockId `AST.SigAssign`
141 AST.Wform [AST.WformElem (AST.Not (AST.PrimName $ AST.NSimple clockId)) Nothing]]
143 -- | generate the output process
144 createOutputProc :: [AST.VHDLId] -- ^ output signal
146 createOutputProc outs =
147 AST.ProcSm (AST.unsafeVHDLBasicId "writeoutput")
149 [AST.IfSm clkPred (writeOuts outs) [] Nothing]
150 where clkPred = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple clockId)
151 (AST.NSimple $ eventId)
153 (AST.PrimName (AST.NSimple clockId) AST.:=: AST.PrimLit "'1'")
154 writeOuts :: [AST.VHDLId] -> [AST.SeqSm]
156 writeOuts [i] = [writeOut i (AST.PrimLit "LF")]
157 writeOuts (i:is) = writeOut i (AST.PrimLit "HT") : writeOuts is
158 writeOut outSig suffix =
159 genExprPCall2 writeId
160 (AST.PrimName $ AST.NSimple outputId)
161 ((genExprFCall showId (AST.PrimName $ AST.NSimple outSig)) AST.:&: suffix)