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