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