X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FVHDL%2FTestbench.hs;fp=c%CE%BBash%2FCLasH%2FVHDL%2FTestbench.hs;h=0000000000000000000000000000000000000000;hb=04f836932ad17dd557af0ba388a12d2b74c1e7d7;hp=fa2e9dc7bde21544cc4236db4a0a319309c0f06e;hpb=75978cf28a619d14ae27ea2bb4a53246b6a0bcd8;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git "a/c\316\273ash/CLasH/VHDL/Testbench.hs" "b/c\316\273ash/CLasH/VHDL/Testbench.hs" deleted file mode 100644 index fa2e9dc..0000000 --- "a/c\316\273ash/CLasH/VHDL/Testbench.hs" +++ /dev/null @@ -1,173 +0,0 @@ --- --- Functions to create a VHDL testbench from a list of test input. --- -module CLasH.VHDL.Testbench where - --- Standard modules -import qualified Control.Monad as Monad -import qualified Maybe -import qualified Data.Map as Map -import qualified Data.Accessor.Monad.Trans.State as MonadState - --- VHDL Imports -import qualified Language.VHDL.AST as AST - --- GHC API -import qualified CoreSyn -import qualified HscTypes -import qualified Var -import qualified TysWiredIn - --- Local imports -import CLasH.Translator.TranslatorTypes -import CLasH.VHDL.Constants -import CLasH.VHDL.Generate -import CLasH.VHDL.VHDLTools -import CLasH.VHDL.VHDLTypes -import CLasH.Normalize -import CLasH.Utils.Core.BinderTools -import CLasH.Utils.Core.CoreTools -import CLasH.Utils - -createTestbench :: - Maybe Int -- ^ Number of cycles to simulate - -> [HscTypes.CoreModule] -- ^ Compiled modules - -> CoreSyn.CoreExpr -- ^ Input stimuli - -> CoreSyn.CoreBndr -- ^ Top Entity - -> TranslatorSession CoreSyn.CoreBndr -- ^ The id of the generated archictecture -createTestbench mCycles cores stimuli top = do - stimuli' <- reduceCoreListToHsList cores stimuli - -- Create a binder for the testbench. We use the unit type (), since the - -- testbench has no outputs and no inputs. - bndr <- mkInternalVar "testbench" TysWiredIn.unitTy - let entity = createTestbenchEntity bndr - MonadState.modify tsEntities (Map.insert bndr entity) - arch <- createTestbenchArch mCycles stimuli' top entity - MonadState.modify tsArchitectures (Map.insert bndr arch) - return bndr - -createTestbenchEntity :: - CoreSyn.CoreBndr - -> Entity -createTestbenchEntity bndr = entity - where - vhdl_id = mkVHDLBasicId "testbench" - -- Create an AST entity declaration with no ports - ent_decl = AST.EntityDec vhdl_id [] - -- Create a signature with no input and no output ports - entity = Entity vhdl_id [] undefined ent_decl - -createTestbenchArch :: - Maybe Int -- ^ Number of cycles to simulate - -> [CoreSyn.CoreExpr] -- ^ Imput stimuli - -> CoreSyn.CoreBndr -- ^ Top Entity - -> Entity -- ^ The signature to create an architecture for - -> TranslatorSession (Architecture, [CoreSyn.CoreBndr]) - -- ^ The architecture and any other entities used. -createTestbenchArch mCycles stimuli top testent= do - signature <- getEntity top - let entId = ent_id signature - iIface = ent_args signature - oIface = ent_res signature - iIds = map fst iIface - let (oId, oDec, oProc) = case oIface of - Just (id, ty) -> ( id - , [AST.SigDec id ty Nothing] - , [createOutputProc [id]]) - -- No output port? Just use undefined for the output id, since it won't be - -- used by mkAssocElems when there is no output port. - Nothing -> (undefined, [], []) - let iDecs = map (\(vId, tm) -> AST.SigDec vId tm Nothing) iIface - let finalIDecs = iDecs ++ - [AST.SigDec clockId std_logicTM (Just $ AST.PrimLit "'0'"), - AST.SigDec resetId std_logicTM (Just $ AST.PrimLit "'0'")] - let portmaps = mkAssocElems (map idToVHDLExpr iIds) (AST.NSimple oId) signature - let mIns = mkComponentInst "totest" entId portmaps - (stimuliAssigns, stimuliDecs, cycles, used) <- createStimuliAssigns mCycles stimuli (head iIds) - let finalAssigns = (AST.CSSASm (AST.NSimple resetId AST.:<==: - AST.ConWforms [] - (AST.Wform [AST.WformElem (AST.PrimLit "'0'") (Just $ AST.PrimLit "0 ns"), AST.WformElem (AST.PrimLit "'1'") (Just $ AST.PrimLit "3 ns")]) - Nothing)) : stimuliAssigns - let clkProc = createClkProc - let arch = AST.ArchBody - (AST.unsafeVHDLBasicId "test") - (AST.NSimple $ ent_id testent) - (map AST.BDISD (finalIDecs ++ stimuliDecs ++ oDec)) - (mIns : - ( (AST.CSPSm clkProc) : (fmap AST.CSPSm oProc) ++ finalAssigns ) ) - return (arch, top : used) - -createStimuliAssigns :: - Maybe Int -- ^ Number of cycles to simulate - -> [CoreSyn.CoreExpr] -- ^ Input stimuli - -> AST.VHDLId -- ^ Input signal - -> TranslatorSession ( [AST.ConcSm] - , [AST.SigDec] - , Int - , [CoreSyn.CoreBndr]) -- ^ (Resulting statements, Needed signals, The number of cycles to simulate, Any entities used) -createStimuliAssigns mCycles [] _ = return ([], [], Maybe.maybe 0 id mCycles, []) - -createStimuliAssigns mCycles stimuli signal = do - let genWformElem time stim = (AST.WformElem stim (Just $ AST.PrimLit (show time ++ " ns"))) - let inputlen = length stimuli - assigns <- Monad.zipWithM createStimulans stimuli [0..inputlen] - let (stimuli_sms, resvars, useds) = unzip3 assigns - sig_dec_maybes <- mapM mkSigDec resvars - let sig_decs = Maybe.catMaybes sig_dec_maybes - outps <- mapM (\x -> MonadState.lift tsType (varToVHDLExpr x)) resvars - let wformelems = zipWith genWformElem [0,10..] outps - let inassign = AST.CSSASm $ AST.NSimple signal AST.:<==: AST.ConWforms [] (AST.Wform wformelems) Nothing - case (concat stimuli_sms) of - [] -> return ([inassign], [], inputlen, concat useds) - stims -> return (stims ++ [inassign], sig_decs, inputlen, concat useds) - -createStimulans :: - CoreSyn.CoreExpr -- ^ The stimulans - -> Int -- ^ The cycle for this stimulans - -> TranslatorSession ( [AST.ConcSm] - , Var.Var - , [CoreSyn.CoreBndr]) -- ^ (The statement, the variable it assigns to (assumed to be available!), Any entities used by this stimulans) - -createStimulans expr cycl = do - -- There must be a let at top level - expr <- normalizeExpr ("test input #" ++ show cycl) expr - -- Split the normalized expression. It can't have a function type, so match - -- an empty list of argument binders - let ([], binds, res) = splitNormalized expr - (stimulansbindss, useds) <- unzipM $ Monad.mapM mkConcSm binds - sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds) - let sig_decs = map (AST.BDISD) (Maybe.catMaybes sig_dec_maybes) - let block_label = mkVHDLExtId ("testcycle_" ++ (show cycl)) - let block = AST.BlockSm block_label [] (AST.PMapAspect []) sig_decs (concat stimulansbindss) - case (sig_decs,(concat stimulansbindss)) of - ([],[]) -> return ([], res, concat useds) - otherwise -> return ([AST.CSBSm block], res, concat useds) - --- | generates a clock process with a period of 10ns -createClkProc :: AST.ProcSm -createClkProc = AST.ProcSm (AST.unsafeVHDLBasicId "clkproc") [] sms - where sms = -- wait for 5 ns -- (half a cycle) - [AST.WaitFor $ AST.PrimLit "5 ns", - -- clk <= not clk; - AST.NSimple clockId `AST.SigAssign` - AST.Wform [AST.WformElem (AST.Not (AST.PrimName $ AST.NSimple clockId)) Nothing]] - --- | generate the output process -createOutputProc :: [AST.VHDLId] -- ^ output signal - -> AST.ProcSm -createOutputProc outs = - AST.ProcSm (AST.unsafeVHDLBasicId "writeoutput") - [clockId] - [AST.IfSm clkPred (writeOuts outs) [] Nothing] - where clkPred = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple clockId) - (AST.NSimple eventId) - Nothing ) `AST.And` - (AST.PrimName (AST.NSimple clockId) AST.:=: AST.PrimLit "'1'") - writeOuts :: [AST.VHDLId] -> [AST.SeqSm] - writeOuts [] = [] - writeOuts [i] = [writeOut i (AST.PrimLit "LF")] - writeOuts (i:is) = writeOut i (AST.PrimLit "HT") : writeOuts is - writeOut outSig suffix = - genExprPCall2 writeId - (AST.PrimName $ AST.NSimple outputId) - ((genExprFCall showId (AST.PrimName $ AST.NSimple outSig)) AST.:&: suffix)